├── grass.bmp ├── Fontello.ttf ├── Andale_Mono.ttf ├── UbuntuMono-R.ttf ├── sources ├── uItem.pas ├── uTalent.pas ├── uCreature.pas ├── Trollhunter.Item.Types.pas ├── Trollhunter.Types.pas ├── uWeather.pas ├── Trollhunter.Player.Types.pas ├── Trollhunter.Utils.pas ├── Trollhunter.Player.Helpers.pas ├── Trollhunter.Scene.Quest.pas ├── Trollhunter.Scene.Enchant.pas ├── Trollhunter.Scene.Rest.pas ├── Trollhunter.Statistic.pas ├── Trollhunter.Scene.Name.pas ├── Trollhunter.Scene.Background.pas ├── uEntity.pas ├── uAbility.pas ├── uAttribute.pas ├── uHelpers.pas ├── Trollhunter.UI.Log.pas ├── Trollhunter.Player.Races.pas ├── uLanguage.pas ├── uSkill.pas ├── Trollhunter.Scene.Options.pas ├── Trollhunter.UI.pas ├── Trollhunter.Scene.Statistics.pas ├── Trollhunter.UI.Logo.pas ├── uSpellbook.pas ├── uQuest.pas ├── uCorpse.pas ├── BearLibItems │ ├── uBearLibItemsCommon.pas │ ├── uBearLibItemsInventory.pas │ └── uBearLibItemsDungeon.pas ├── uCalendar.pas ├── Trollhunter.Player.Classes.pas ├── Trollhunter.Scene.Help.pas ├── BearLibPathFind │ └── uPathFind.pas ├── Trollhunter.Item.Shop.pas ├── Trollhunter.Terminal.pas ├── uGame.pas ├── Trollhunter.Scene.RacesAndClasses.pas ├── BearLibTerminal │ └── BearLibTerminal.pas └── uMap.pas ├── BearLibTerminal.dll ├── screenshots ├── logo.png ├── screenshot_1.png ├── screenshot_2.png ├── screenshot_3.png └── screenshot_4.png ├── terminal_x64 └── BearLibTerminal.dll ├── terminal_x86 └── BearLibTerminal.dll ├── .gitignore ├── CLEAN.BAT ├── clean.sh ├── LICENSE ├── config.ini ├── README.md ├── Trollhunter.dof ├── Trollhunter.dpr ├── languages └── default.lng └── Trollhunter.lpi /grass.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/grass.bmp -------------------------------------------------------------------------------- /Fontello.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/Fontello.ttf -------------------------------------------------------------------------------- /Andale_Mono.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/Andale_Mono.ttf -------------------------------------------------------------------------------- /UbuntuMono-R.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/UbuntuMono-R.ttf -------------------------------------------------------------------------------- /sources/uItem.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/sources/uItem.pas -------------------------------------------------------------------------------- /BearLibTerminal.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/BearLibTerminal.dll -------------------------------------------------------------------------------- /sources/uTalent.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/sources/uTalent.pas -------------------------------------------------------------------------------- /screenshots/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/screenshots/logo.png -------------------------------------------------------------------------------- /sources/uCreature.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/sources/uCreature.pas -------------------------------------------------------------------------------- /screenshots/screenshot_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/screenshots/screenshot_1.png -------------------------------------------------------------------------------- /screenshots/screenshot_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/screenshots/screenshot_2.png -------------------------------------------------------------------------------- /screenshots/screenshot_3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/screenshots/screenshot_3.png -------------------------------------------------------------------------------- /screenshots/screenshot_4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/screenshots/screenshot_4.png -------------------------------------------------------------------------------- /terminal_x64/BearLibTerminal.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/terminal_x64/BearLibTerminal.dll -------------------------------------------------------------------------------- /terminal_x86/BearLibTerminal.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/terminal_x86/BearLibTerminal.dll -------------------------------------------------------------------------------- /sources/Trollhunter.Item.Types.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/devapromix/troll-hunter/HEAD/sources/Trollhunter.Item.Types.pas -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.compiled 2 | *.rsj 3 | *.rst 4 | *.o 5 | *.or 6 | *.ppu 7 | *~ 8 | *.a 9 | *.log 10 | *.lps 11 | *.bak 12 | *.dbg 13 | *.exe 14 | *.fuse_hidden* 15 | -------------------------------------------------------------------------------- /sources/Trollhunter.Types.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Types; 2 | 3 | interface 4 | 5 | type 6 | Int = System.NativeInt; 7 | UInt = System.Word; 8 | 9 | const 10 | UIntMax = High(Byte); 11 | 12 | implementation 13 | 14 | end. 15 | -------------------------------------------------------------------------------- /CLEAN.BAT: -------------------------------------------------------------------------------- 1 | del /s *.~* 2 | del /s *.dcu 3 | del /s *.txt 4 | del /s *.ppu 5 | del /s *.bak 6 | del /s *.identcache 7 | del /s *.otares 8 | del /s *.local 9 | del /s *.cfg 10 | del /s *.ddp 11 | del /s *.o 12 | del /s *.a 13 | -------------------------------------------------------------------------------- /sources/uWeather.pas: -------------------------------------------------------------------------------- 1 | unit uWeather; 2 | 3 | interface 4 | 5 | type 6 | TWindEnum = (wdNone, wdN, wdNE, wdE, wSE, wdS, wdSW, wW, wNW); 7 | 8 | type 9 | TWeatherEnum = (wtClear, wtRain); 10 | 11 | implementation 12 | 13 | end. 14 | -------------------------------------------------------------------------------- /clean.sh: -------------------------------------------------------------------------------- 1 | find . -name '*.~*' -delete 2 | find . -name '*.dcu' -delete 3 | find . -name '*.txt' -delete 4 | find . -name '*.ppu' -delete 5 | # файли типу lps містять розклад вікна програми, тому їх бажано не видаляти, а от грузити на гіт - не обов’язково 6 | # find . -name '*.lps' -delete 7 | find . -name '*.bak' -delete 8 | find . -name '*.identcache' -delete 9 | find . -name '*.otares' -delete 10 | find . -name '*.cfg' -delete 11 | find . -name '*.ddp' -delete 12 | find . -name '*.o' -delete 13 | find . -name '*.a' -delete 14 | find . -name '*.local' -delete 15 | 16 | rm .fuse_hidden* 17 | find . -name '*.so' -delete 18 | find . -name '*.dbg' -delete 19 | rm -r backup 20 | rm -r lib 21 | 22 | 23 | -------------------------------------------------------------------------------- /sources/Trollhunter.Player.Types.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Player.Types; 2 | 3 | interface 4 | 5 | uses Types; 6 | 7 | type 8 | TDirectionEnum = (drEast, drWest, drSouth, drNorth, drSouthEast, drSouthWest, 9 | drNorthEast, drNorthWest, drOrigin); 10 | 11 | const 12 | Direction: array [TDirectionEnum] of TPoint = ((X: 1; Y: 0), (X: - 1; Y: 0), 13 | (X: 0; Y: 1), (X: 0; Y: - 1), (X: 1; Y: 1), (X: - 1; Y: 1), (X: 1; Y: - 1), 14 | (X: - 1; Y: - 1), (X: 0; Y: 0)); 15 | 16 | type 17 | TSexEnum = (sxMale, sxFemale); 18 | 19 | type 20 | TSlotType = (stNone, stHead, stTorso, stHands, stFeet, stMainHand, stOffHand, 21 | stNeck, stFinger, stTorch); 22 | 23 | implementation 24 | 25 | end. 26 | -------------------------------------------------------------------------------- /sources/Trollhunter.Utils.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Utils; 2 | 3 | interface 4 | 5 | type 6 | Utils = class(TObject) 7 | public 8 | class function GetPath(SubDir: string): string; 9 | class procedure AppStr(var S: string; P: string; IsSep: Boolean); 10 | end; 11 | 12 | implementation 13 | 14 | uses SysUtils; 15 | 16 | class procedure Utils.AppStr(var S: string; P: string; IsSep: Boolean); 17 | begin 18 | if IsSep then 19 | S := S + ', ' + P 20 | else 21 | S := S + P; 22 | end; 23 | 24 | class function Utils.GetPath(SubDir: string): string; 25 | begin 26 | Result := ExtractFilePath(ParamStr(0)); 27 | Result := IncludeTrailingPathDelimiter(Result + SubDir); 28 | end; 29 | 30 | end. 31 | -------------------------------------------------------------------------------- /sources/Trollhunter.Player.Helpers.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Player.Helpers; 2 | 3 | interface 4 | 5 | uses Trollhunter.Player; 6 | 7 | type 8 | TPlayerHelper = class helper for TPlayer 9 | function FullName: string; 10 | function Gender: string; 11 | end; 12 | 13 | implementation 14 | 15 | uses SysUtils, 16 | Trollhunter.Player.Types, 17 | Trollhunter.Player.Races, 18 | Trollhunter.Player.Classes, 19 | uLanguage; 20 | 21 | { TPlayerHelper } 22 | 23 | function TPlayerHelper.FullName: string; 24 | begin 25 | Result := Format('%s, %s (%s), %s', [Player.Name, Races.GetName(Player.HRace), 26 | Gender, Trollhunter.Player.Classes.Classes.GetName(Player.HClass)]) 27 | end; 28 | 29 | function TPlayerHelper.Gender: string; 30 | begin 31 | if (Player.Sex = sxMale) then 32 | Result := _('Male') 33 | else 34 | Result := _('Female'); 35 | end; 36 | 37 | end. 38 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Quest.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Quest; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, uScenes; 6 | 7 | type 8 | TSceneQuest = class(TScene) 9 | public 10 | procedure Render; override; 11 | procedure Update(var Key: UInt); override; 12 | end; 13 | 14 | implementation 15 | 16 | { TSceneQuest } 17 | 18 | uses Trollhunter.UI, uQuest, uLanguage, BearLibTerminal, uGame; 19 | 20 | procedure TSceneQuest.Render; 21 | begin 22 | UI.Title(Quests.GetName(Quests.Current), 1); 23 | 24 | AddKey('Enter', _('Accept')); 25 | AddKey('Esc', _('Decline'), True); 26 | end; 27 | 28 | procedure TSceneQuest.Update(var Key: UInt); 29 | begin 30 | case Key of 31 | TK_ESCAPE: 32 | Scenes.GoBack(); 33 | TK_ENTER, TK_KP_ENTER: 34 | begin 35 | Quests.Add(Quests.Current); 36 | Scenes.GoBack(); 37 | end 38 | else 39 | Game.Timer := UIntMax; 40 | end 41 | end; 42 | 43 | end. 44 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Enchant.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Enchant; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, 6 | uScenes; 7 | 8 | type 9 | TSceneEnchant = class(TScene) 10 | public 11 | Suffix: UInt; 12 | procedure Render; override; 13 | procedure Update(var Key: UInt); override; 14 | end; 15 | 16 | implementation 17 | 18 | uses Trollhunter.UI, 19 | uLanguage, 20 | uItem, 21 | Trollhunter.UI.Log, 22 | Trollhunter.Terminal, 23 | BearLibTerminal, 24 | Trollhunter.Player, 25 | uGame; 26 | 27 | { TSceneEnchant } 28 | 29 | procedure TSceneEnchant.Render; 30 | begin 31 | UI.Title(_('Enchant an item'), 1, clDarkestRed); 32 | 33 | UI.FromAToZ(); 34 | Items.RenderInventory(); 35 | MsgLog.Render(2, True); 36 | 37 | AddKey('A-Z', _('Select an item')); 38 | AddKey('Esc', _('Close'), True); 39 | end; 40 | 41 | procedure TSceneEnchant.Update(var Key: UInt); 42 | begin 43 | case Key of 44 | TK_ESCAPE: 45 | Scenes.SetScene(scInv); 46 | TK_A .. TK_Z: 47 | Player.CraftItem(Key - TK_A); 48 | else 49 | Game.Timer := UIntMax; 50 | end 51 | end; 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Sergiy Tkach 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /config.ini: -------------------------------------------------------------------------------- 1 | [BearLibTerminal] 2 | window: fullscreen=false 3 | log: file=log.txt, level=trace 4 | ;font: UbuntuMono-R.ttf, size=16 5 | ;font: CALIGULA.TTF, size=11 6 | ;0x40: at.png, align=center 7 | ;0xE000: grass.bmp, size=32x32 8 | 9 | [Player] 10 | ;Sets the default name of the player 11 | name=PLAYER 12 | 13 | [Localization] 14 | language=en 15 | 16 | [Screen] 17 | width=0 18 | ;height=60 19 | ;height=45 20 | 21 | [Panel] 22 | width=0 23 | 24 | [Palette] 25 | lush=95,255,45 26 | mana=50,50,250 27 | life=200,0,0 28 | food=150,100,0 29 | poison=100,250,100 30 | vision=40,90,10 31 | blood=200,30,30 32 | unidentified=255,80,80 33 | nomana=100,100,100 34 | flask=255,200,55 35 | rare=100,180,240 36 | strength=190,25,160 37 | dexterity=160,125,200 38 | willpower=110,25,210 39 | perception=35,115,125 40 | blessed=100,100,180 41 | cursed=180,100,100 42 | gold=35,128,35 43 | 44 | [Colors] 45 | default=Yellow 46 | background=Black 47 | key=Light Green 48 | equip=Lightest Amber 49 | alarm=Lighter Amber 50 | log=Light Yellow 51 | look=Dark Yellow 52 | title=Light Yellow 53 | bkmob=Darkest Red 54 | player=Lime 55 | manabar=Mana 56 | lifebar=Life 57 | bkplayer=Darkest Lush 58 | corpse=Dark Yellow 59 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Rest.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Rest; 2 | 3 | interface 4 | 5 | uses uScenes, 6 | Trollhunter.Types; 7 | 8 | type 9 | TSceneRest = class(TScene) 10 | public 11 | procedure Render; override; 12 | procedure Update(var Key: UInt); override; 13 | end; 14 | 15 | implementation 16 | 17 | { TSceneRest } 18 | 19 | uses SysUtils, 20 | Trollhunter.UI, 21 | Trollhunter.Terminal, 22 | BearLibTerminal, 23 | uLanguage, 24 | Trollhunter.UI.Log, 25 | Trollhunter.Player; 26 | 27 | procedure TSceneRest.Render; 28 | begin 29 | UI.Title(_('Rest duration')); 30 | 31 | UI.FromAToZ; 32 | Y := 1; 33 | 34 | Inc(Y); 35 | Terminal.Print(1, Y, UI.KeyToStr(Chr(Y + 95)) + ' ' + _('Rest for 10 turns'), 36 | TK_ALIGN_LEFT); 37 | Inc(Y); 38 | Terminal.Print(1, Y, UI.KeyToStr(Chr(Y + 95)) + ' ' + _('Rest for 100 turns'), 39 | TK_ALIGN_LEFT); 40 | Inc(Y); 41 | Terminal.Print(1, Y, UI.KeyToStr(Chr(Y + 95)) + ' ' + 42 | _('Rest for 1000 turns'), TK_ALIGN_LEFT); 43 | 44 | MsgLog.Render(2, True); 45 | 46 | AddKey('Esc', _('Back'), True); 47 | end; 48 | 49 | procedure TSceneRest.Update(var Key: UInt); 50 | begin 51 | case Key of 52 | TK_A, TK_B, TK_C: 53 | Player.Rest(StrToInt('1' + StringOfChar('0', Key - TK_A + 1))); 54 | TK_ESCAPE: 55 | Scenes.SetScene(scGame); 56 | end 57 | end; 58 | 59 | end. 60 | -------------------------------------------------------------------------------- /sources/Trollhunter.Statistic.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Statistic; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | type 8 | TStatEnum = (stScore, stTurn, stKills, stSpCast, stFound, stPotDrunk, 9 | stScrRead, stItUsed, stItIdent, stItCrafted, stItRep, stFdEat, stAge, 10 | stWeight, stHeight, stMetabolism, stCoinsLooted); 11 | 12 | type 13 | TStatistics = class(TObject) 14 | private 15 | FStat: array [TStatEnum] of UInt; 16 | public 17 | constructor Create; 18 | destructor Destroy; override; 19 | procedure Clear; 20 | procedure Inc(const I: TStatEnum; const Value: UInt = 1); 21 | function Get(const I: TStatEnum): UInt; 22 | procedure SetValue(const I: TStatEnum; const Value: UInt); 23 | end; 24 | 25 | implementation 26 | 27 | { TStatistics } 28 | 29 | procedure TStatistics.Clear; 30 | var 31 | I: TStatEnum; 32 | begin 33 | for I := Low(TStatEnum) to High(TStatEnum) do 34 | FStat[I] := 0; 35 | end; 36 | 37 | constructor TStatistics.Create; 38 | begin 39 | Self.Clear; 40 | end; 41 | 42 | destructor TStatistics.Destroy; 43 | begin 44 | 45 | inherited; 46 | end; 47 | 48 | function TStatistics.Get(const I: TStatEnum): UInt; 49 | begin 50 | Result := FStat[I]; 51 | end; 52 | 53 | procedure TStatistics.Inc(const I: TStatEnum; const Value: UInt = 1); 54 | begin 55 | FStat[I] := FStat[I] + Value; 56 | end; 57 | 58 | procedure TStatistics.SetValue(const I: TStatEnum; const Value: UInt); 59 | begin 60 | FStat[I] := Value; 61 | end; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Name.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Name; 2 | 3 | interface 4 | 5 | uses uScenes, 6 | Trollhunter.Types; 7 | 8 | type 9 | TSceneName = class(TScene) 10 | public 11 | procedure Render; override; 12 | procedure Update(var Key: UInt); override; 13 | end; 14 | 15 | implementation 16 | 17 | uses Trollhunter.Terminal, 18 | Trollhunter.UI, 19 | Trollhunter.Player, 20 | uGame, 21 | uLanguage, 22 | BearLibTerminal; 23 | 24 | { TSceneName } 25 | 26 | procedure TSceneName.Render; 27 | begin 28 | UI.Title(_('Choose a name')); 29 | 30 | Terminal.Print(CX - 14, CY, _('Enter your player''s name') + ': ' + 31 | Player.Name + Game.GetCursor, TK_ALIGN_LEFT); 32 | 33 | AddKey('Enter', _('Confirm')); 34 | AddKey('Esc', _('Back'), True); 35 | end; 36 | 37 | procedure TSceneName.Update(var Key: UInt); 38 | begin 39 | case Key of 40 | TK_BACKSPACE: 41 | begin 42 | if (Player.Name <> '') then 43 | Player.Name := Copy(Player.Name, 1, Length(Player.Name) - 1); 44 | end; 45 | TK_ENTER, TK_KP_ENTER: 46 | begin 47 | if (Player.Name = '') then 48 | Player.Name := _('PLAYER'); 49 | Scenes.SetScene(scBackground, scName); 50 | end; 51 | TK_A .. TK_Z: 52 | begin 53 | if (Length(Player.Name) < 10) then 54 | Player.Name := Player.Name + Chr(Key - TK_A + 65); 55 | end; 56 | TK_ESCAPE: 57 | begin 58 | Player.Talents.Clear; 59 | Scenes.SetScene(scTalents, scClass); 60 | end; 61 | end; 62 | end; 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Background.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Background; 2 | 3 | interface 4 | 5 | uses 6 | Trollhunter.Types, 7 | uScenes; 8 | 9 | type 10 | TSceneBackground = class(TScene) 11 | private 12 | procedure StartGame; 13 | public 14 | procedure Render; override; 15 | procedure Update(var AKey: UInt); override; 16 | end; 17 | 18 | implementation 19 | 20 | { TSceneBackground } 21 | 22 | uses 23 | Trollhunter.UI, 24 | BearLibTerminal, 25 | Trollhunter.Terminal, 26 | Trollhunter.Player, 27 | uLanguage, 28 | uGame, 29 | uMap; 30 | 31 | const 32 | DELAY_MS = 1000; 33 | 34 | procedure TSceneBackground.Render; 35 | begin 36 | UI.Title(_('Character Background')); 37 | 38 | Terminal.ForegroundColor(clGray); 39 | Terminal.Print(CX - (CX div 2), CY - (CY div 2), CX, CY, Player.Background, 40 | TK_ALIGN_BOTTOM); 41 | 42 | if not Mode.Game then 43 | begin 44 | AddKey('Enter', _('Start game')); 45 | AddKey('Space', _('Re-roll')); 46 | end; 47 | AddKey('Esc', _('Close'), _('Back'), True); 48 | end; 49 | 50 | procedure TSceneBackground.StartGame; 51 | begin 52 | Scenes.SetScene(scLoad); 53 | Terminal.Refresh; 54 | Terminal_Delay(DELAY_MS); 55 | Map.Gen; 56 | Mode.Game := True; 57 | Player.Talents.DoTalent(TSceneTalents(Scenes.GetScene(scTalents)).Talent); 58 | Player.StartEquip; 59 | Player.StartSkills; 60 | Scenes.SetScene(scGame); 61 | end; 62 | 63 | procedure TSceneBackground.Update(var AKey: UInt); 64 | begin 65 | case AKey of 66 | TK_ENTER, TK_KP_ENTER: 67 | if not Mode.Game then 68 | StartGame; 69 | TK_SPACE: 70 | if not Mode.Game then 71 | Player.GenerateBackground(); 72 | TK_ESCAPE: 73 | Scenes.GoBack(); 74 | end; 75 | end; 76 | 77 | end. 78 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![screenshot](https://github.com/devapromix-roguelikes/troll-hunter/blob/master/screenshots/logo.png) 2 | 3 | ## Introduction 4 | Trollhunter is a single-player roguelike game. 5 | 6 | Far away in an uncharted region of the Earth land Elvion lies surrounded by mountains. In the center of this land there is a village named Dork. It's people are in grave danger as the Troll King and his armies are marching to lay waste on all of its inhabitants. Unless a hero will rise to take a stand against the forces of evil. 7 | 8 | You are the hero who departs on a quest to stop the enemies and save your homeland, Elvion. Survive, gather equipment, fight adversaries and be ready for the final confrontation. Good luck! You will need it. 9 | 10 | ## Current State 11 | The game is currently in demo stage with very limited contents and lots of issues to solve and improve. 12 | 13 | ## Contributing 14 | Contributions are welcome! Please fork this repository and then once you have made and tested your changes, submit a pull request. 15 | 16 | ## System requirements 17 | 18 | at least 1GHz CPU recommended 19 | at least 1024x768 graphic mode recommended 20 | at least 512Mb RAM recommended 21 | at least 64Mb VRAM recommended 22 | 23 | No installation is required, just extract all files to one folder and play. 24 | You may need to set "executable" bit in Linux. 25 | 26 | ## Screenshots 27 | ![screenshot](https://github.com/devapromix-roguelikes/troll-hunter/blob/master/screenshots/screenshot_1.png) 28 | 29 | ![screenshot](https://github.com/devapromix-roguelikes/troll-hunter/blob/master/screenshots/screenshot_2.png) 30 | 31 | ![screenshot](https://github.com/devapromix-roguelikes/troll-hunter/blob/master/screenshots/screenshot_3.png) 32 | 33 | ![screenshot](https://github.com/devapromix-roguelikes/troll-hunter/blob/master/screenshots/screenshot_4.png) 34 | 35 | ![screenshot](https://github.com/devapromix-roguelikes/troll-hunter/blob/master/screenshots/screenshot_5.png) 36 | 37 | ## Credits 38 | Copyright (C) 2017-2018 by Sergiy Tkach (Apromix). 39 | 40 | Trollhunter is open source, written in pascal, the full source is available at: 41 | https://github.com/devapromix-roguelikes/troll-hunter -------------------------------------------------------------------------------- /sources/uEntity.pas: -------------------------------------------------------------------------------- 1 | unit uEntity; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, uMap; 6 | 7 | type 8 | TEntity = class(TObject) 9 | private 10 | FX: UInt; 11 | FY: UInt; 12 | FZ: TMapEnum; 13 | public 14 | constructor Create; 15 | destructor Destroy; override; 16 | property X: UInt read FX write FX; 17 | property Y: UInt read FY write FY; 18 | property Z: TMapEnum read FZ write FZ; 19 | function GetDist(ToX, ToY: Single): UInt; 20 | function GetCapit(S: string): string; 21 | function GetDescAn(S: string): string; 22 | function GetDescThe(S: string): string; 23 | function GetPureText(S: string): string; 24 | end; 25 | 26 | implementation 27 | 28 | uses SysUtils, uGame, uLanguage; 29 | 30 | { TEntity } 31 | 32 | constructor TEntity.Create; 33 | begin 34 | 35 | end; 36 | 37 | destructor TEntity.Destroy; 38 | begin 39 | 40 | inherited; 41 | end; 42 | 43 | function TEntity.GetCapit(S: string): string; 44 | begin 45 | if (Trim(S) <> '') then 46 | Result := UpCase(S[1]) + Copy(S, 2, Length(S)) 47 | else Result := '(???)' + S; 48 | end; 49 | 50 | function TEntity.GetDescAn(S: string): string; 51 | begin 52 | if (Trim(S) <> '') then 53 | Result := LowerCase(S) 54 | else Result := '(???)' + S; 55 | if (Language.Current <> 'english') then 56 | Exit; 57 | if (Result[1] in ['a', 'e', 'i', 'o', 'u']) then 58 | Result := 'an ' + Result 59 | else 60 | Result := 'a ' + Result; 61 | end; 62 | 63 | function TEntity.GetDescThe(S: string): string; 64 | begin 65 | if (Trim(S) <> '') then 66 | Result := LowerCase(S) 67 | else Result := '(???)' + S; 68 | if (Language.Current <> 'english') then 69 | Exit; 70 | Result := 'the ' + Result; 71 | end; 72 | 73 | function TEntity.GetDist(ToX, ToY: Single): UInt; 74 | begin 75 | Result := Round(Sqrt(Sqr(ToX - X) + Sqr(ToY - Y))); 76 | end; 77 | 78 | function TEntity.GetPureText(S: string): string; 79 | var 80 | I: Int; 81 | B: Boolean; 82 | begin 83 | B := True; 84 | Result := ''; 85 | S := StringReplace(S, '[[', '[', [rfReplaceAll]); 86 | S := StringReplace(S, ']]', ']', [rfReplaceAll]); 87 | for I := 1 to Length(S) do 88 | begin 89 | if (S[I] = '[') then 90 | B := False; 91 | if B then 92 | Result := Result + S[I]; 93 | if (S[I] = ']') then 94 | B := True; 95 | end; 96 | end; 97 | 98 | end. 99 | -------------------------------------------------------------------------------- /Trollhunter.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=1 21 | R=1 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir= 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;vclx;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;adortl;ibxpress;vclactnband;bdertl;vclshlctrls;dclOfficeXP 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams=-w 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Version Info] 109 | IncludeVerInfo=1 110 | AutoIncBuild=0 111 | MajorVer=1 112 | MinorVer=0 113 | Release=0 114 | Build=0 115 | Debug=0 116 | PreRelease=0 117 | Special=0 118 | Private=0 119 | DLL=0 120 | Locale=1049 121 | CodePage=1251 122 | [Version Info Keys] 123 | CompanyName= 124 | FileDescription= 125 | FileVersion=1.0.0.0 126 | InternalName= 127 | LegalCopyright= 128 | LegalTrademarks= 129 | OriginalFilename= 130 | ProductName= 131 | ProductVersion=1.0.0.0 132 | Comments= 133 | [HistoryLists\hlUnitAliases] 134 | Count=1 135 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 136 | -------------------------------------------------------------------------------- /sources/uAbility.pas: -------------------------------------------------------------------------------- 1 | unit uAbility; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | type 8 | TAbilityEnum = (abPoisoned, abBlinded, abStunned, abBurning, abRegen, 9 | abSleeping, abBloodlust, abCursed, abDrunk, abDiseased, abWeak, abAfraid, 10 | abArmor_Reduction, abLight, abBerserk, abWeightless); 11 | 12 | type 13 | TSetOfAbility = set of TAbilityEnum; 14 | 15 | type 16 | TAbilities = class(TObject) 17 | private 18 | FAbilityName: array [TAbilityEnum] of string; 19 | FAbility: array [TAbilityEnum] of UInt; 20 | function GetAbility(const I: TAbilityEnum): UInt; 21 | procedure SetAbility(const I: TAbilityEnum; const Value: UInt); 22 | public 23 | constructor Create; 24 | destructor Destroy; override; 25 | procedure Clear; 26 | property Ability[const I: TAbilityEnum]: UInt read GetAbility 27 | write SetAbility; 28 | function IsAbility(const Value: TAbilityEnum): Boolean; 29 | procedure Modify(const I: TAbilityEnum; const Value: Int); 30 | function GetName(const Value: TAbilityEnum): string; 31 | function GetColor(const Value: TAbilityEnum): string; 32 | end; 33 | 34 | implementation 35 | 36 | uses SysUtils, TypInfo, uHelpers; 37 | 38 | { TAbility } 39 | 40 | const 41 | AbilityColor: array [TAbilityEnum] of string = ('Lighter Green', 'White', 42 | 'Dark Yellow', 'Light Red', 'Lighter Red', 'Yellow', 'Dark Red', 43 | 'Dark Green', 'Light Blue', 'Dark Red', 'Dark White', 'Light Green', 44 | 'Light Yellow', 'Lighter Yellow', 'Light Red', 'Light Blue'); 45 | 46 | procedure TAbilities.Modify(const I: TAbilityEnum; const Value: Int); 47 | begin 48 | FAbility[I] := FAbility[I] + Value; 49 | end; 50 | 51 | procedure TAbilities.Clear; 52 | var 53 | I: TAbilityEnum; 54 | begin 55 | for I := Low(TAbilityEnum) to High(TAbilityEnum) do 56 | Ability[I] := 0; 57 | end; 58 | 59 | constructor TAbilities.Create; 60 | var 61 | I: TAbilityEnum; 62 | P: Pointer; 63 | begin 64 | Self.Clear; 65 | P := TypeInfo(TAbilityEnum); 66 | for I := Low(TAbilityEnum) to High(TAbilityEnum) do 67 | FAbilityName[I] := GetEnumName(P, Ord(I)).GetName('ab'); 68 | end; 69 | 70 | destructor TAbilities.Destroy; 71 | begin 72 | 73 | inherited; 74 | end; 75 | 76 | function TAbilities.GetAbility(const I: TAbilityEnum): UInt; 77 | begin 78 | Result := FAbility[I] 79 | end; 80 | 81 | function TAbilities.GetColor(const Value: TAbilityEnum): string; 82 | begin 83 | Result := AbilityColor[Value]; 84 | end; 85 | 86 | function TAbilities.IsAbility(const Value: TAbilityEnum): Boolean; 87 | begin 88 | Result := Ability[Value] > 0; 89 | end; 90 | 91 | procedure TAbilities.SetAbility(const I: TAbilityEnum; const Value: UInt); 92 | begin 93 | FAbility[I] := Value; 94 | end; 95 | 96 | function TAbilities.GetName(const Value: TAbilityEnum): string; 97 | begin 98 | Result := FAbilityName[Value]; 99 | end; 100 | 101 | end. 102 | -------------------------------------------------------------------------------- /sources/uAttribute.pas: -------------------------------------------------------------------------------- 1 | unit uAttribute; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | const 8 | AttribMax = 100; 9 | 10 | type 11 | TAttribEnum = (atDef, atMinDamage, atMaxDamage, atPV, atDV, atStr, atDex, 12 | atWil, atPer, atLife, atMana, atMaxLife, atMaxMana, atExtraGold, atVision, 13 | atSat, atLev, atExp, atReLife, atReMana, atLifeAfEachKill, 14 | atManaAfEachKill); 15 | 16 | const 17 | AttrLow = atReLife; 18 | AttrHigh = atManaAfEachKill; 19 | 20 | type 21 | TAttrib = record 22 | Value: UInt; 23 | Prm: UInt; 24 | end; 25 | 26 | type 27 | TAttributes = class(TObject) 28 | private 29 | FAttrib: array [TAttribEnum] of TAttrib; 30 | function GetAttrib(I: TAttribEnum): TAttrib; 31 | procedure SetAttrib(I: TAttribEnum; const Value: TAttrib); 32 | public 33 | constructor Create; 34 | destructor Destroy; override; 35 | procedure Clear; 36 | property Attrib[I: TAttribEnum]: TAttrib read GetAttrib write SetAttrib; 37 | procedure Modify(const I: TAttribEnum; const AValue: Int = 1; 38 | const APrm: Int = 0); 39 | procedure SetValue(const I: TAttribEnum; const AValue: Int); overload; 40 | procedure SetPrm(const I: TAttribEnum; const APrm: Int); 41 | procedure SetValue(const I, J: TAttribEnum); overload; 42 | end; 43 | 44 | implementation 45 | 46 | uses uHelpers, dialogs; 47 | 48 | { TAttributes } 49 | 50 | procedure TAttributes.Clear; 51 | var 52 | I: TAttribEnum; 53 | begin 54 | for I := Low(FAttrib) to High(FAttrib) do 55 | begin 56 | FAttrib[I].Value := 0; 57 | FAttrib[I].Prm := 0; 58 | end; 59 | end; 60 | 61 | constructor TAttributes.Create; 62 | begin 63 | 64 | end; 65 | 66 | destructor TAttributes.Destroy; 67 | begin 68 | 69 | inherited; 70 | end; 71 | 72 | function TAttributes.GetAttrib(I: TAttribEnum): TAttrib; 73 | begin 74 | Result := FAttrib[I]; 75 | end; 76 | 77 | procedure TAttributes.Modify(const I: TAttribEnum; const AValue, APrm: Int); 78 | var 79 | V: Int; 80 | begin 81 | V := FAttrib[I].Value + AValue; 82 | if (V < 0) then 83 | V := 0; 84 | FAttrib[I].Value := V; 85 | FAttrib[I].Prm := FAttrib[I].Prm + APrm; 86 | case I of 87 | atLife: 88 | SetValue(I, FAttrib[I].Value.InRange(FAttrib[atMaxLife].Value)); 89 | atMana: 90 | SetValue(I, FAttrib[I].Value.InRange(FAttrib[atMaxMana].Value)); 91 | end; 92 | end; 93 | 94 | procedure TAttributes.SetAttrib(I: TAttribEnum; const Value: TAttrib); 95 | begin 96 | FAttrib[I] := Value; 97 | end; 98 | 99 | procedure TAttributes.SetPrm(const I: TAttribEnum; const APrm: Int); 100 | begin 101 | FAttrib[I].Prm := APrm; 102 | end; 103 | 104 | procedure TAttributes.SetValue(const I, J: TAttribEnum); 105 | begin 106 | FAttrib[I].Value := FAttrib[J].Value; 107 | end; 108 | 109 | procedure TAttributes.SetValue(const I: TAttribEnum; const AValue: Int); 110 | begin 111 | FAttrib[I].Value := AValue; 112 | end; 113 | 114 | end. 115 | -------------------------------------------------------------------------------- /sources/uHelpers.pas: -------------------------------------------------------------------------------- 1 | unit uHelpers; 2 | 3 | interface 4 | 5 | uses Classes, 6 | Trollhunter.Types, 7 | uBearLibItemsCommon, 8 | Trollhunter.Player; 9 | 10 | type 11 | TIntHelper = record helper for Int 12 | public 13 | function Percent(AValue: Int): Int; inline; 14 | function InRange(AMaxValue: Int): Int; inline; 15 | function ToString: string; 16 | end; 17 | 18 | type 19 | TUIntHelper = record helper for UInt 20 | public 21 | function Percent(AValue: Int): Int; inline; 22 | function InRange(AMaxValue: UInt): UInt; inline; 23 | function ToString: string; 24 | end; 25 | 26 | type 27 | TStringHelper = record helper for 28 | string 29 | function GetName(const Pref: string): string; 30 | end; 31 | 32 | type 33 | TStringListHelper = class helper for TStringList 34 | function Join(const CharSeparator: Char): string; 35 | function Explode(const CharSeparator: Char; const Source: string) 36 | : TStringList; 37 | end; 38 | 39 | type 40 | TItemHelper = record helper for Item 41 | function DoIt: string; 42 | end; 43 | 44 | implementation 45 | 46 | uses SysUtils, Math; 47 | 48 | { IntHelper } 49 | 50 | function TIntHelper.InRange(AMaxValue: Int): Int; 51 | begin 52 | Result := EnsureRange(Self, 0, AMaxValue); 53 | end; 54 | 55 | function TIntHelper.Percent(AValue: Int): Int; 56 | begin 57 | Result := Round(Self * AValue / 100); 58 | end; 59 | 60 | function TIntHelper.ToString: string; 61 | begin 62 | Result := IntToStr(Self); 63 | end; 64 | 65 | { UIntHelper } 66 | 67 | function TUIntHelper.InRange(AMaxValue: UInt): UInt; 68 | begin 69 | Result := EnsureRange(Self, 0, AMaxValue); 70 | end; 71 | 72 | function TUIntHelper.Percent(AValue: Int): Int; 73 | begin 74 | Result := Round(Self * AValue / 100); 75 | end; 76 | 77 | function TUIntHelper.ToString: string; 78 | begin 79 | Result := IntToStr(Self); 80 | end; 81 | 82 | { TItemHelper } 83 | 84 | function TItemHelper.DoIt: string; 85 | begin 86 | 87 | end; 88 | 89 | { TStringHelper } 90 | 91 | function TStringHelper.GetName(const Pref: string): string; 92 | begin 93 | Result := StringReplace(Self, Pref, '', [rfReplaceAll]); 94 | Result := StringReplace(Result, '_', ' ', [rfReplaceAll]); 95 | end; 96 | 97 | { TStringListHelper } 98 | 99 | function TStringListHelper.Join(const CharSeparator: Char): string; 100 | var 101 | I: Integer; 102 | begin 103 | Result := ''; 104 | for I := 0 to Self.Count - 1 do 105 | if (I < Self.Count - 1) then 106 | Result := Result + Self[I] + CharSeparator 107 | else 108 | Result := Result + Self[I]; 109 | end; 110 | 111 | function TStringListHelper.Explode(const CharSeparator: Char; 112 | const Source: string): TStringList; 113 | var 114 | I: Integer; 115 | Strings: TStringList; 116 | begin 117 | Strings := TStringList.Create; 118 | Strings.Delimiter := CharSeparator; 119 | Strings.DelimitedText := Source; 120 | for I := Strings.Count - 1 downto 0 do 121 | if (Strings[I] = '') then 122 | Strings.Delete(I); 123 | Result := Strings; 124 | end; 125 | 126 | end. 127 | -------------------------------------------------------------------------------- /sources/Trollhunter.UI.Log.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.UI.Log; 2 | 3 | interface 4 | 5 | uses 6 | Trollhunter.Types, 7 | Classes; 8 | 9 | type 10 | TMsgLog = class(TObject) 11 | private 12 | FAct: string; 13 | FMsg: string; 14 | FLog: TStringList; 15 | function GetColorByIndex(const AIndex: Int): string; 16 | public 17 | constructor Create; 18 | destructor Destroy; override; 19 | procedure Render(const Y: UInt = 0; Flag: Boolean = False); 20 | procedure Clear; 21 | procedure Add(const AMsg: string); 22 | procedure Turn; 23 | property Msg: string read FMsg write FMsg; 24 | function GetLastMsg(const ACount: Int): string; 25 | procedure RenderAllMessages; 26 | end; 27 | 28 | var 29 | MsgLog: TMsgLog = nil; 30 | 31 | implementation 32 | 33 | uses 34 | SysUtils, 35 | StrUtils, 36 | Math, 37 | Trollhunter.Terminal, 38 | BearLibTerminal, 39 | Trollhunter.Player, 40 | uGame; 41 | 42 | { TMsgLog } 43 | 44 | const 45 | MAX_LOG_CAPACITY = 50; 46 | 47 | function TMsgLog.GetColorByIndex(const AIndex: Int): string; 48 | begin 49 | Result := IfThen(Odd(AIndex), 'dark gray', 'light gray'); 50 | end; 51 | 52 | procedure TMsgLog.Add(const AMsg: string); 53 | begin 54 | FMsg := FMsg + ' ' + Trim(AMsg); 55 | Game.Timer := UIntMax; 56 | while FLog.Count >= MAX_LOG_CAPACITY do 57 | FLog.Delete(0); 58 | end; 59 | 60 | procedure TMsgLog.Clear; 61 | begin 62 | FAct := ''; 63 | FMsg := ''; 64 | FLog.Clear; 65 | end; 66 | 67 | constructor TMsgLog.Create; 68 | begin 69 | FLog := TStringList.Create; 70 | end; 71 | 72 | destructor TMsgLog.Destroy; 73 | begin 74 | FreeAndNil(FLog); 75 | inherited; 76 | end; 77 | 78 | function TMsgLog.GetLastMsg(const ACount: Int): string; 79 | var 80 | I, C: Int; 81 | LStringList: TStringList; 82 | begin 83 | LStringList := TStringList.Create; 84 | try 85 | C := Math.Min(ACount, FLog.Count); 86 | for I := C downto 1 do 87 | LStringList.Append(Terminal.Colorize(FLog[FLog.Count - I], 88 | GetColorByIndex(I))); 89 | Result := LStringList.Text; 90 | finally 91 | FreeAndNil(LStringList); 92 | end; 93 | end; 94 | 95 | procedure TMsgLog.Render(const Y: UInt = 0; Flag: Boolean = False); 96 | begin 97 | if (Flag and (Game.Timer = 0)) then 98 | Exit; 99 | Player.RenderInfo; 100 | if (Trim(MsgLog.Msg) = '') then 101 | FAct := '' 102 | else 103 | FAct := Terminal.Colorize(Trim(FMsg), Terminal.GetColorFromIni('Log')); 104 | Terminal.ForegroundColor(clGray); 105 | Terminal.Print(Log.Left, Log.Top + Y, Log.Width, Log.Height, 106 | Trim(Self.GetLastMsg(MAX_LOG_CAPACITY) + FAct), TK_ALIGN_BOTTOM); 107 | end; 108 | 109 | procedure TMsgLog.RenderAllMessages; 110 | var 111 | S: string; 112 | I, C: Int; 113 | begin 114 | S := ''; 115 | C := Math.Min(Screen.Height - 3, FLog.Count); 116 | for I := C downto 1 do 117 | S := S + ' ' + Terminal.Colorize(FLog[FLog.Count - I], GetColorByIndex(I)); 118 | Terminal.ForegroundColor(clGray); 119 | Terminal.Print(1, 2, Screen.Width - 1, Screen.Height - 4, Trim(S), 120 | TK_ALIGN_BOTTOM); 121 | end; 122 | 123 | procedure TMsgLog.Turn; 124 | begin 125 | if (Trim(FMsg) <> '') then 126 | FLog.Append(Trim(FMsg)); 127 | end; 128 | 129 | initialization 130 | 131 | MsgLog := TMsgLog.Create; 132 | 133 | finalization 134 | 135 | FreeAndNil(MsgLog); 136 | 137 | end. 138 | -------------------------------------------------------------------------------- /sources/Trollhunter.Player.Races.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Player.Races; 2 | 3 | interface 4 | 5 | uses 6 | Trollhunter.Types, 7 | uCreature; 8 | 9 | type 10 | TRaceEnum = (rcHuman, rcElf, rcGnome, rcDwarf); 11 | 12 | type 13 | TRaceProp = record 14 | Description: string; 15 | Age: TMinMax; 16 | Height: TMinMax; 17 | Weight: TMinMax; 18 | Metabolism: TMinMax; 19 | Strength: TMinMax; 20 | Dexterity: TMinMax; 21 | Willpower: TMinMax; 22 | Perception: TMinMax; 23 | Life: TMinMax; 24 | Mana: TMinMax; 25 | end; 26 | 27 | const 28 | RaceProp: array [TRaceEnum] of TRaceProp = ( 29 | // Human 30 | (Description: 'Humans are the most common of races.'; 31 | Age: (Min: 18; Max: 50;); Height: (Min: 160; Max: 180;); 32 | Weight: (Min: 70; Max: 110;); Metabolism: (Min: 80; Max: 85;); 33 | Strength: (Min: 1; Max: 2;); Dexterity: (Min: 1; Max: 2;); 34 | Willpower: (Min: 1; Max: 2;); Perception: (Min: 1; Max: 2;); 35 | Life: (Min: 5; Max: 8;); Mana: (Min: 5; Max: 8;);), 36 | // Elf 37 | (Description: 'Elf'; Age: (Min: 75; Max: 800;); Height: (Min: 190; Max: 250; 38 | ); Weight: (Min: 50; Max: 100;); Metabolism: (Min: 60; Max: 65;); 39 | Strength: (Min: 1; Max: 1;); Dexterity: (Min: 1; Max: 3;); 40 | Willpower: (Min: 1; Max: 3;); Perception: (Min: 1; Max: 2;); 41 | Life: (Min: 5; Max: 10;); Mana: (Min: 10; Max: 15;);), 42 | // Gnome 43 | (Description: 'Gnome'; Age: (Min: 20; Max: 160;); Height: (Min: 90; 44 | Max: 130;); Weight: (Min: 70; Max: 110;); Metabolism: (Min: 95; Max: 100;); 45 | Strength: (Min: 1; Max: 2;); Dexterity: (Min: 1; Max: 2;); 46 | Willpower: (Min: 1; Max: 3;); Perception: (Min: 1; Max: 3;); 47 | Life: (Min: 5; Max: 10;); Mana: (Min: 10; Max: 15;);), 48 | // Dwarf 49 | (Description: 'Dwarf'; Age: (Min: 20; Max: 250;); Height: (Min: 100; 50 | Max: 150;); Weight: (Min: 80; Max: 120;); Metabolism: (Min: 115; Max: 120;); 51 | Strength: (Min: 1; Max: 3;); Dexterity: (Min: 1; Max: 3;); 52 | Willpower: (Min: 1; Max: 1;); Perception: (Min: 1; Max: 2;); 53 | Life: (Min: 10; Max: 15;); Mana: (Min: 5; Max: 10;);) 54 | /// /// 55 | ); 56 | 57 | type 58 | TRace = record 59 | 60 | end; 61 | 62 | type 63 | TRaces = class(TObject) 64 | private 65 | FRaceName: array [TRaceEnum] of string; 66 | public 67 | constructor Create; 68 | destructor Destroy; override; 69 | function GetName(I: TRaceEnum): string; 70 | function GetDescription(I: TRaceEnum): string; 71 | end; 72 | 73 | var 74 | Races: TRaces; 75 | 76 | implementation 77 | 78 | uses TypInfo, 79 | SysUtils, 80 | uHelpers; 81 | 82 | { TRaces } 83 | 84 | constructor TRaces.Create; 85 | var 86 | I: TRaceEnum; 87 | P: Pointer; 88 | begin 89 | P := TypeInfo(TRaceEnum); 90 | for I := Low(TRaceEnum) to High(TRaceEnum) do 91 | FRaceName[I] := GetEnumName(P, Ord(I)).GetName('rc'); 92 | end; 93 | 94 | destructor TRaces.Destroy; 95 | begin 96 | 97 | inherited; 98 | end; 99 | 100 | function TRaces.GetDescription(I: TRaceEnum): string; 101 | begin 102 | Result := RaceProp[I].Description; 103 | end; 104 | 105 | function TRaces.GetName(I: TRaceEnum): string; 106 | begin 107 | Result := FRaceName[I] 108 | end; 109 | 110 | initialization 111 | 112 | Races := TRaces.Create; 113 | 114 | finalization 115 | 116 | FreeAndNil(Races); 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /sources/uLanguage.pas: -------------------------------------------------------------------------------- 1 | unit uLanguage; 2 | 3 | interface 4 | 5 | uses Classes; 6 | 7 | type 8 | TLanguage = class(TObject) 9 | private 10 | FID: TStringList; 11 | FSL: TStringList; 12 | FValue: TStringList; 13 | FCurrent: string; 14 | FUseDefaultLanguage: Boolean; 15 | function GetPath(SubDir: string): string; 16 | public 17 | function Get(const AValue: string): string; 18 | constructor Create(const AUseDefaultLanguage: Boolean = False); 19 | destructor Destroy; override; 20 | procedure Clear; 21 | procedure SaveDefault; 22 | procedure LoadFromFile(AFileName: string); 23 | procedure SaveToFile(AFileName: string); 24 | procedure UseLanguage(ACurrentLanguage: string); 25 | property Current: string read FCurrent write FCurrent; 26 | property UseDefaultLanguage: Boolean read FUseDefaultLanguage; 27 | end; 28 | 29 | function _(const AValue: string): string; 30 | 31 | var 32 | Language: TLanguage; 33 | 34 | implementation 35 | 36 | uses SysUtils; 37 | 38 | { TLanguage } 39 | 40 | function _(const AValue: string): string; 41 | begin 42 | if Assigned(Language) then 43 | begin 44 | if Language.UseDefaultLanguage then 45 | Language.FSL.Append(AValue + '='); 46 | Result := Language.Get(AValue); 47 | end 48 | else 49 | Result := AValue; 50 | end; 51 | 52 | procedure TLanguage.Clear; 53 | begin 54 | FID.Clear; 55 | FValue.Clear; 56 | end; 57 | 58 | constructor TLanguage.Create(const AUseDefaultLanguage: Boolean = False); 59 | var 60 | F: string; 61 | begin 62 | FSL := TStringList.Create; 63 | FSL.Sorted := True; 64 | FSL.Duplicates := dupIgnore; 65 | FUseDefaultLanguage := AUseDefaultLanguage; 66 | F := GetPath('languages') + 'default.lng'; 67 | if FileExists(F) then 68 | FSL.LoadFromFile(F); 69 | FID := TStringList.Create; 70 | FValue := TStringList.Create; 71 | FCurrent := 'english'; 72 | end; 73 | 74 | destructor TLanguage.Destroy; 75 | begin 76 | FreeAndNil(FValue); 77 | FreeAndNil(FID); 78 | FreeAndNil(FSL); 79 | inherited; 80 | end; 81 | 82 | procedure TLanguage.LoadFromFile(AFileName: string); 83 | var 84 | S: string; 85 | I, J: Integer; 86 | SL: TStringList; 87 | begin 88 | if not FileExists(AFileName) then 89 | Exit; 90 | SL := TStringList.Create; 91 | try 92 | SL.LoadFromFile(AFileName); 93 | for I := 0 to SL.Count - 1 do 94 | begin 95 | S := SL[I]; 96 | J := Pos('=', S); 97 | FID.Append(Copy(S, 1, J - 1)); 98 | Delete(S, 1, J); 99 | FValue.Append(S); 100 | end; 101 | finally 102 | FreeAndNil(SL); 103 | end; 104 | end; 105 | 106 | procedure TLanguage.SaveDefault; 107 | begin 108 | if Language.UseDefaultLanguage then 109 | SaveToFile(GetPath('languages') + 'default.lng'); 110 | end; 111 | 112 | procedure TLanguage.SaveToFile(AFileName: string); 113 | begin 114 | FSL.SaveToFile(AFileName); 115 | end; 116 | 117 | procedure TLanguage.UseLanguage(ACurrentLanguage: string); 118 | begin 119 | Clear; 120 | Current := ACurrentLanguage; 121 | LoadFromFile(GetPath('languages') + Current + '.lng'); 122 | end; 123 | 124 | function TLanguage.Get(const AValue: string): string; 125 | var 126 | I: Integer; 127 | begin 128 | I := FID.IndexOf(AValue); 129 | if (I < 0) or (FValue[I] = '') then 130 | Result := AValue 131 | else 132 | Result := FValue[I]; 133 | end; 134 | 135 | function TLanguage.GetPath(SubDir: string): string; 136 | begin 137 | Result := ExtractFilePath(ParamStr(0)); 138 | Result := IncludeTrailingPathDelimiter(Result + SubDir); 139 | end; 140 | 141 | end. 142 | -------------------------------------------------------------------------------- /sources/uSkill.pas: -------------------------------------------------------------------------------- 1 | unit uSkill; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | type 8 | TSkillEnum = ( 9 | // 10 | skNone, 11 | // 12 | skStealth, 13 | // Attributes skills 14 | skAthletics, skDodge, skConcentration, skToughness, 15 | // 16 | skBodybuilding, skMeditation, skEnchant_Item, 17 | // Weapon skills 18 | skBlade, skAxe, skSpear, skMace, skDagger, skStaff, skWand, skBow); 19 | 20 | type 21 | TSkill = record 22 | Value: Int; 23 | Exp: Int; 24 | end; 25 | 26 | type 27 | TSkills = class(TObject) 28 | private 29 | FSkillName: array [TSkillEnum] of string; 30 | FSkill: array [TSkillEnum] of TSkill; 31 | function GetSkill(I: TSkillEnum): TSkill; 32 | procedure SetSkill(I: TSkillEnum; const Value: TSkill); 33 | public 34 | constructor Create; 35 | destructor Destroy; override; 36 | procedure Clear; 37 | property Skill[I: TSkillEnum]: TSkill read GetSkill write SetSkill; 38 | procedure DoSkill(ASkill: TSkillEnum; AExpValue: UInt = 1); 39 | procedure Modify(I: TSkillEnum; Value: Int); 40 | function GetName(I: TSkillEnum): string; 41 | end; 42 | 43 | const 44 | SkillMin = 5; 45 | SkillMax = 75; 46 | SkillExpMax = 50; 47 | BeginSkill = 10; 48 | StartSkill = 5; 49 | 50 | implementation 51 | 52 | uses SysUtils, 53 | TypInfo, 54 | Math, 55 | uLanguage, 56 | Trollhunter.Terminal, 57 | Trollhunter.Player, 58 | uGame, 59 | Trollhunter.UI.Log, 60 | Trollhunter.Statistic, 61 | uHelpers; 62 | 63 | { TSkills } 64 | 65 | procedure TSkills.Clear; 66 | var 67 | I: TSkillEnum; 68 | begin 69 | for I := Low(TSkillEnum) to High(TSkillEnum) do 70 | with FSkill[I] do 71 | begin 72 | Value := SkillMin; 73 | Exp := 0; 74 | end; 75 | end; 76 | 77 | constructor TSkills.Create; 78 | var 79 | I: TSkillEnum; 80 | P: Pointer; 81 | begin 82 | Self.Clear; 83 | P := TypeInfo(TSkillEnum); 84 | for I := Low(TSkillEnum) to High(TSkillEnum) do 85 | FSkillName[I] := GetEnumName(P, Ord(I)).GetName('sk'); 86 | end; 87 | 88 | destructor TSkills.Destroy; 89 | begin 90 | 91 | inherited; 92 | end; 93 | 94 | procedure TSkills.DoSkill(ASkill: TSkillEnum; AExpValue: UInt); 95 | begin 96 | if (Skill[ASkill].Value < SkillMax) and (ASkill <> skNone) then 97 | begin 98 | FSkill[ASkill].Exp := FSkill[ASkill].Exp + Math.RandomRange(0, 99 | AExpValue + 1) + 1; 100 | if (Skill[ASkill].Exp >= SkillExpMax) then 101 | begin 102 | FSkill[ASkill].Exp := FSkill[ASkill].Exp - SkillExpMax; 103 | Inc(FSkill[ASkill].Value); 104 | FSkill[ASkill].Value := EnsureRange(FSkill[ASkill].Value, SkillMin, 105 | SkillMax); 106 | // Add message {!!!} 107 | MsgLog.Add(Terminal.Colorize(Format(_('Your skill %s has raised to %d!'), 108 | [GetName(ASkill), FSkill[ASkill].Value]), clAlarm)); 109 | // Add exp 110 | Player.AddExp(); 111 | // Add scores 112 | if (FSkill[ASkill].Value = SkillMax) then 113 | Player.Statictics.Inc(stScore, 50); 114 | Player.Calc; 115 | end; 116 | end; 117 | 118 | end; 119 | 120 | function TSkills.GetName(I: TSkillEnum): string; 121 | begin 122 | Result := FSkillName[I]; 123 | end; 124 | 125 | function TSkills.GetSkill(I: TSkillEnum): TSkill; 126 | begin 127 | Result := FSkill[I] 128 | end; 129 | 130 | procedure TSkills.Modify(I: TSkillEnum; Value: Int); 131 | begin 132 | FSkill[I].Value := Math.EnsureRange(FSkill[I].Value + Value, SkillMin, 133 | SkillMax); 134 | end; 135 | 136 | procedure TSkills.SetSkill(I: TSkillEnum; const Value: TSkill); 137 | begin 138 | FSkill[I] := Value 139 | end; 140 | 141 | end. 142 | -------------------------------------------------------------------------------- /Trollhunter.dpr: -------------------------------------------------------------------------------- 1 | {$IFDEF FPC} 2 | {$IFDEF Windows} 3 | {$APPTYPE GUI} 4 | {$ENDIF} 5 | {$ENDIF} 6 | program Trollhunter; 7 | 8 | uses 9 | SysUtils, 10 | Dialogs, 11 | Trollhunter.Types in 'Sources\Trollhunter.Types.pas', 12 | uGame in 'Sources\uGame.pas', 13 | uLanguage in 'Sources\uLanguage.pas', 14 | Trollhunter.Terminal in 'Sources\Trollhunter.Terminal.pas', 15 | uScenes in 'Sources\uScenes.pas', 16 | Trollhunter.Player in 'Sources\Trollhunter.Player.pas', 17 | uMap in 'Sources\uMap.pas', 18 | uItem in 'Sources\uItem.pas', 19 | uMob in 'Sources\uMob.pas', 20 | Trollhunter.UI.Log in 'Sources\Trollhunter.UI.Log.pas', 21 | uCorpse in 'Sources\uCorpse.pas', 22 | uEntity in 'Sources\uEntity.pas', 23 | uCalendar in 'Sources\uCalendar.pas', 24 | Trollhunter.Item.Shop in 'Sources\Trollhunter.Item.Shop.pas', 25 | uSpellbook in 'Sources\uSpellbook.pas', 26 | uTalent in 'Sources\uTalent.pas', 27 | uAbility in 'Sources\uAbility.pas', 28 | uSkill in 'Sources\uSkill.pas', 29 | Trollhunter.UI.Logo in 'Sources\Trollhunter.UI.Logo.pas', 30 | Trollhunter.Statistic in 'sources\Trollhunter.Statistic.pas', 31 | Trollhunter.Item.Affixes in 'Sources\Trollhunter.Item.Affixes.pas', 32 | uCreature in 'Sources\uCreature.pas', 33 | uAttribute in 'Sources\uAttribute.pas', 34 | Trollhunter.UI in 'Sources\Trollhunter.UI.pas', 35 | BearLibTerminal in 'Sources\BearLibTerminal\BearLibTerminal.pas', 36 | uPathFind in 'Sources\BearLibPathFind\uPathFind.pas', 37 | uBearLibItemsCommon in 'Sources\BearLibItems\uBearLibItemsCommon.pas', 38 | uBearLibItemsDungeon in 'Sources\BearLibItems\uBearLibItemsDungeon.pas', 39 | uBearLibItemsInventory in 'Sources\BearLibItems\uBearLibItemsInventory.pas', 40 | uQuest in 'Sources\uQuest.pas', 41 | uHelpers in 'Sources\uHelpers.pas', 42 | uWeather in 'sources\uWeather.pas', 43 | Trollhunter.Player.Races in 'sources\Trollhunter.Player.Races.pas', 44 | Trollhunter.Player.Classes in 'sources\Trollhunter.Player.Classes.pas', 45 | Trollhunter.Scene.Enchant in 'sources\Trollhunter.Scene.Enchant.pas', 46 | Trollhunter.Scene.Name in 'sources\Trollhunter.Scene.Name.pas', 47 | Trollhunter.Scene.Rest in 'sources\Trollhunter.Scene.Rest.pas', 48 | Trollhunter.Scene.RacesAndClasses in 'sources\Trollhunter.Scene.RacesAndClasses.pas', 49 | Trollhunter.Scene.Quest in 'sources\Trollhunter.Scene.Quest.pas', 50 | Trollhunter.Utils in 'sources\Trollhunter.Utils.pas', 51 | Trollhunter.Scene.Background in 'sources\Trollhunter.Scene.Background.pas', 52 | Trollhunter.Item.Types in 'sources\Trollhunter.Item.Types.pas', 53 | Trollhunter.Player.Types in 'sources\Trollhunter.Player.Types.pas', 54 | Trollhunter.Scene.Statistics in 'sources\Trollhunter.Scene.Statistics.pas', 55 | Trollhunter.Scene.Options in 'sources\Trollhunter.Scene.Options.pas', 56 | Trollhunter.Player.Helpers in 'sources\Trollhunter.Player.Helpers.pas', 57 | Trollhunter.Scene.Help in 'sources\Trollhunter.Scene.Help.pas'; 58 | 59 | var 60 | Key: UInt = 0; 61 | IsRender: Boolean = True; 62 | 63 | begin 64 | Randomize(); 65 | {$IFNDEF FPC} 66 | {$IF COMPILERVERSION >= 18} 67 | ReportMemoryLeaksOnShutdown := True; 68 | {$IFEND} 69 | {$ENDIF} 70 | Game.LoadConfig(); 71 | repeat 72 | if (Game.Timer > 0) then 73 | begin 74 | Game.Timer := Game.Timer - 1; 75 | if (Game.Timer = 0) then 76 | IsRender := True; 77 | end; 78 | if IsRender then 79 | begin 80 | Scenes.Render(); 81 | Terminal.Refresh(); 82 | end; 83 | Key := 0; 84 | if terminal_has_input() then 85 | begin 86 | Key := terminal_read(); 87 | Scenes.Update(Key); 88 | IsRender := True; 89 | Continue; 90 | end; 91 | terminal_delay(10); 92 | IsRender := False; 93 | until Game.CanClose; 94 | 95 | end. 96 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Options.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Options; 2 | 3 | interface 4 | 5 | uses uScenes, 6 | Trollhunter.Types; 7 | 8 | type 9 | TSceneOptions = class(TScene) 10 | public 11 | procedure Render; override; 12 | procedure Update(var Key: UInt); override; 13 | end; 14 | 15 | implementation 16 | 17 | { TSceneOptions } 18 | 19 | uses uGame, 20 | Trollhunter.UI, 21 | uLanguage, 22 | BearLibTerminal, Trollhunter.Item.Shop; 23 | 24 | procedure TSceneOptions.Render; 25 | begin 26 | Y := 1; 27 | // Options 28 | Title(_('Options')); 29 | 30 | AddOption('C', _('Auto pick up coins'), Game.GetOption(apCoin)); 31 | AddOption('G', _('Auto pick up gems'), Game.GetOption(apGem)); 32 | AddOption('F', _('Auto pick up food'), Game.GetOption(apFood)); 33 | AddOption('Y', _('Auto pick up plants'), Game.GetOption(apPlant)); 34 | AddOption('P', _('Auto pick up potions and flasks'), 35 | Game.GetOption(apPotion)); 36 | AddOption('U', _('Auto pick up flasks'), Game.GetOption(apFlask)); 37 | AddOption('O', _('Auto pick up magic items'), Game.GetOption(apMagic)); 38 | AddOption('S', _('Auto pick up scrolls'), Game.GetOption(apScroll)); 39 | AddOption('R', _('Auto pick up runes'), Game.GetOption(apRune)); 40 | AddOption('B', _('Auto pick up books'), Game.GetOption(apBook)); 41 | AddOption('K', _('Auto pick up keys'), Game.GetOption(apKey)); 42 | AddOption('D', _('Show items price in inventory'), Game.GetOption(apShPrice)); 43 | 44 | // Settings 45 | Title(_('Settings'), False); 46 | AddOption('W', _('Fullscreen'), Game.GetOption(apFullscreen), clLightBlue); 47 | 48 | // Wizard mode 49 | if Mode.Wizard then 50 | begin 51 | Title(_('Wizard Mode'), False); 52 | 53 | AddOption('Z', _('Turn Wizard Mode Off'), Mode.Wizard, clRed); 54 | AddOption('M', _('Show map'), Game.ShowMap); 55 | AddOption('T', _('Reload all shops'), False); 56 | // AddOption('J', _(''), False); 57 | AddOption('L', _('Leave corpses'), Game.LCorpses); 58 | AddOption('I', _('Show ID of items'), Game.ShowID); 59 | AddOption('N', _('Hide level of an item'), Game.GetOption(apHdLevOfItem)); 60 | end; 61 | 62 | AddKey('Esc', _('Back'), True); 63 | end; 64 | 65 | procedure TSceneOptions.Update(var Key: UInt); 66 | begin 67 | case Key of 68 | // Options 69 | TK_C: 70 | Game.ChOption(apCoin); 71 | TK_G: 72 | Game.ChOption(apGem); 73 | TK_F: 74 | Game.ChOption(apFood); 75 | TK_Y: 76 | Game.ChOption(apPlant); 77 | TK_P: 78 | Game.ChOption(apPotion); 79 | TK_O: 80 | Game.ChOption(apMagic); 81 | TK_U: 82 | Game.ChOption(apFlask); 83 | TK_S: 84 | Game.ChOption(apScroll); 85 | TK_R: 86 | Game.ChOption(apRune); 87 | TK_K: 88 | Game.ChOption(apKey); 89 | TK_B: 90 | Game.ChOption(apBook); 91 | TK_D: 92 | Game.ChOption(apShPrice); 93 | // Settings 94 | TK_W: 95 | begin 96 | Game.ChOption(apFullscreen); 97 | Game.ChScreen; 98 | end; 99 | // Wizard mode 100 | TK_Z: 101 | Mode.Wizard := False; 102 | TK_M: 103 | if Mode.Wizard then 104 | Game.ShowMap := not Game.ShowMap; 105 | TK_L: 106 | if Mode.Wizard then 107 | Game.LCorpses := not Game.LCorpses; 108 | TK_T: 109 | if Mode.Wizard then 110 | begin 111 | Shops.New; 112 | Scenes.SetScene(scGame); 113 | end; 114 | TK_I: 115 | if Mode.Wizard then 116 | Game.ShowID := not Game.ShowID; 117 | TK_N: 118 | if Mode.Wizard then 119 | Game.ChOption(apHdLevOfItem); 120 | TK_ESCAPE: 121 | Scenes.SetScene(scGame); 122 | end 123 | end; 124 | 125 | end. 126 | -------------------------------------------------------------------------------- /sources/Trollhunter.UI.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.UI; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, Trollhunter.UI.Log; 6 | 7 | type 8 | TIconEnum = (icMale, icFemale, icPlus, icMinus, icQuestion, icGold, icFlag, 9 | icLife, icMana, icStar, icHammer, icElixir, icShield, icFood, icLeaf, 10 | icFeather, icStr, icDex, icBook, icVision, icFire, icIce, 11 | icLightning, icDrop, icSword, icSun, icMoon, icTroph, icAst, icKey, icRepair, 12 | icBook2); 13 | 14 | type 15 | UI = class(TObject) 16 | class procedure Bar(const X, LM, Y, Wd: UInt; const Cur, Max: UInt; 17 | const AColor, ADarkColor: Cardinal); 18 | class procedure Title(const S: string; AY: UInt = 1; BGColor: Cardinal = 0); 19 | class procedure FromAToZ(const Max: UInt = 0); 20 | class procedure RenderTile(const S: string); 21 | class function KeyToStr(AKey: string; AStr: string = ''; 22 | AColor: string = 'Key'): string; 23 | class function GoldLeft(const Value: Cardinal): string; 24 | class function Icon(const AIcon: TIconEnum; const AColor: string = ''): string; 25 | end; 26 | 27 | implementation 28 | 29 | uses 30 | SysUtils, BearLibTerminal, Trollhunter.Terminal, uGame, uLanguage; 31 | 32 | const 33 | IconStr: array [TIconEnum] of string = ('F8D0','F8D1','F8D2','F8D3','F8D4', 34 | 'F8D5','F8D6','F8D7','F8D8','F8D9','F8DA','F8DB','F8DC','F8DD','F8DE','F8DF', 35 | 'F8E0','F8E1','F8E2','F8E3','F8E4','F8E5','F8E6','F8E7','F8E8','F8E9','F8EA', 36 | 'F8EB','F8EC','F8ED','F8EE','F8EF'); 37 | F = '[[%s]]'; 38 | 39 | { UI } 40 | 41 | class procedure UI.Bar(const X, LM, Y, Wd: UInt; const Cur, Max: UInt; 42 | const AColor, ADarkColor: Cardinal); 43 | var 44 | I, L, W: UInt; 45 | begin 46 | L := Wd; 47 | W := Round(Cur / Max * L); 48 | for I := 0 to L do 49 | begin 50 | Terminal.BackgroundColor(ADarkColor); 51 | if ((I <= W) and (Cur > 0)) then 52 | Terminal.BackgroundColor(AColor); 53 | Terminal.Print(X + I + LM, Y, ' '); 54 | Terminal.BackgroundColor(0); 55 | end; 56 | end; 57 | 58 | class procedure UI.FromAToZ(const Max: UInt = 0); 59 | var 60 | I: Char; 61 | J: UInt; 62 | begin 63 | if Mode.Wizard then 64 | for I := 'A' to 'Z' do 65 | Terminal.Print(1, (Ord(I) - Ord('A')) + 2, Format(F, [I]), clGray, clBlack) 66 | else if (Max > 0) then 67 | for J := 1 to Max do 68 | Terminal.Print(1, J + 1, Format(F, [Chr(J + Ord('A') - 1)]), clDarkGray, clBlack); 69 | end; 70 | 71 | class function UI.GoldLeft(const Value: Cardinal): string; 72 | begin 73 | Result := Format(F, [Format(UI.Icon(icGold) + _('%d gold left'), [Value])]); 74 | end; 75 | 76 | class function UI.Icon(const AIcon: TIconEnum; const AColor: string): string; 77 | begin 78 | if (AColor = '') then 79 | Result := Format('[font=icon][U+%s][/font]', [UpperCase(IconStr[AIcon])]) 80 | else 81 | Result := Format('[font=icon][color=%s][U+%s][/color][/font]', 82 | [LowerCase(AColor), UpperCase(IconStr[AIcon])]); 83 | end; 84 | 85 | class function UI.KeyToStr(AKey, AStr, AColor: string): string; 86 | begin 87 | Result := Trim(Terminal.Colorize(Format(F, [UpperCase(AKey)]), 88 | Terminal.GetColorFromIni(AColor)) + ' ' + AStr); 89 | end; 90 | 91 | class procedure UI.RenderTile(const S: string); 92 | begin 93 | Terminal.Print(0, 0, '[U+E000]'); 94 | end; 95 | 96 | class procedure UI.Title(const S: string; AY: UInt = 1; BGColor: Cardinal = 0); 97 | var 98 | GX: UInt; 99 | begin 100 | if (BGColor > 0) then 101 | begin 102 | Terminal.BackgroundColor(BGColor); 103 | Terminal.Clear; 104 | end; 105 | GX := Terminal.Window.Width div 2; 106 | Terminal.ForegroundColor(Terminal.GetColorFromIni('Title', 'Yellow')); 107 | Terminal.Print(GX, AY, Format(FT, [S]), TK_ALIGN_CENTER); 108 | Terminal.ForegroundColor(clDefault); 109 | end; 110 | 111 | end. 112 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Statistics.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Statistics; 2 | 3 | interface 4 | 5 | uses uScenes, 6 | Trollhunter.Types; 7 | 8 | type 9 | TSceneStatistics = class(TScene) 10 | public 11 | procedure Render; override; 12 | procedure Update(var Key: UInt); override; 13 | end; 14 | 15 | implementation 16 | 17 | uses SysUtils, 18 | Trollhunter.UI, 19 | Trollhunter.Player, 20 | Trollhunter.Player.Types, 21 | uGame, 22 | uLanguage, 23 | Trollhunter.Player.Races, 24 | Trollhunter.Player.Classes, 25 | Trollhunter.Statistic, 26 | uAttribute, 27 | uBearLibItemsCommon, 28 | BearLibTerminal, 29 | uSkill, 30 | uItem, 31 | uMob, 32 | Trollhunter.Item.Affixes, 33 | Trollhunter.Item.Types, 34 | Trollhunter.Item.Shop, 35 | uQuest, 36 | Trollhunter.Player.Helpers; 37 | 38 | var 39 | Wizard: Boolean = False; 40 | 41 | { TSceneStatistics } 42 | 43 | procedure TSceneStatistics.Render; 44 | begin 45 | Y := 1; 46 | if Mode.Wizard and Wizard then 47 | begin 48 | Title(_('Wizard Mode')); 49 | 50 | Add(_('Monsters'), Ord(Length(MobBase)) - (13 + 7)); 51 | Add(_('Bosses'), 13); 52 | Add(_('NPCs'), 7); 53 | Add(_('Items'), Ord(Length(ItemBase))); 54 | Add(_('Shops'), Shops.Count); 55 | Add(_('Quests'), Quests.Amount); 56 | Add(_('Talents'), Player.Talents.Amount); 57 | Add(_('Affixes'), Affixes.Amount); 58 | Add(_('Item Types'), Ord(High(TItemType))); 59 | Add(_('Skills'), Ord(High(TSkillEnum))); 60 | end 61 | else 62 | begin 63 | Title(Player.FullName); 64 | 65 | Add(_('Level'), Player.Attributes.Attrib[atLev].Value); 66 | Add(_('Scores'), Player.Statictics.Get(stScore)); 67 | Add(_('Age'), Player.Statictics.Get(stAge)); 68 | Add(_('Weight'), Player.Statictics.Get(stWeight)); 69 | Add(_('Height'), Player.Statictics.Get(stHeight)); 70 | Add(_('Metabolism'), Player.Statictics.Get(stMetabolism)); 71 | 72 | Title(_('Statistics'), False); 73 | 74 | // Add(_('Talent'), Player.GetTalentName(Player.GetTalent(0))); 75 | Add(_('Tiles Moved'), Player.Statictics.Get(stTurn)); 76 | Add(_('Monsters Killed'), Player.Statictics.Get(stKills)); 77 | Add(_('Items Found'), Player.Statictics.Get(stFound)); 78 | // Add(_('Chests Found'), ); 79 | // Add(_('Doors Opened'), ); 80 | Add(_('Potions Drunk'), Player.Statictics.Get(stPotDrunk)); 81 | Add(_('Scrolls Read'), Player.Statictics.Get(stScrRead)); 82 | Add(_('Spells Cast'), Player.Statictics.Get(stSpCast)); 83 | Add(_('Foods Eaten'), Player.Statictics.Get(stFdEat)); 84 | // Add(_('Melee Attack Performed'), ); 85 | // Add(_('Ranged Attack Performed'), ); 86 | // Add(_('Unarmed Attack Performed'), ); 87 | // Add(_('Times Fallen Into Pit'), ); 88 | // Add(_('Items Sold'), ); 89 | Add(_('Items Used'), Player.Statictics.Get(stItUsed)); 90 | Add(_('Items Repaired'), Player.Statictics.Get(stItRep)); 91 | Add(_('Items Identified'), Player.Statictics.Get(stItIdent)); 92 | Add(_('Items Crafted'), Player.Statictics.Get(stItCrafted)); 93 | Add(_('Coins Looted'), Player.Statictics.Get(stCoinsLooted)); 94 | // Add(_('Gold from Sales'), ); 95 | // Add(_(''), ); 96 | end; 97 | 98 | if Wizard then 99 | begin 100 | Title(_('Version'), False); 101 | 102 | Add(_('Game Version'), Game.GetVersion); 103 | Add(_('BeaRLibTerminal'), BearLibTerminal.terminal_get('version')); 104 | Self.Add(); 105 | Add(_('BeaRLibItems'), Items_GetVersion); 106 | end; 107 | 108 | AddKey('Esc', _('Close'), not Mode.Wizard); 109 | if Mode.Wizard then 110 | if Wizard then 111 | AddKey('Z', _('Back'), True) 112 | else 113 | AddKey('Z', _('Wizard Mode'), True); 114 | end; 115 | 116 | procedure TSceneStatistics.Update(var Key: UInt); 117 | begin 118 | case Key of 119 | TK_ESCAPE: 120 | // Close 121 | Scenes.SetScene(scGame); 122 | TK_Z: 123 | if Mode.Wizard then 124 | Wizard := not Wizard; 125 | end; 126 | end; 127 | 128 | end. 129 | -------------------------------------------------------------------------------- /sources/Trollhunter.UI.Logo.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.UI.Logo; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | type 8 | TLogo = class(TObject) 9 | private 10 | FX: UInt; 11 | FL: array [0 .. 17] of string; 12 | public 13 | constructor Create; 14 | destructor Destroy; override; 15 | procedure Render(const IsSword: Boolean); 16 | function Width: UInt; 17 | end; 18 | 19 | var 20 | Logo: TLogo; 21 | 22 | implementation 23 | 24 | uses SysUtils, BearLibTerminal, Trollhunter.Terminal; 25 | 26 | const 27 | T: array [0 .. 17] of string = 28 | (' ______________ ', 29 | '| ____ . ____ | ___ ___ ___ ___ ', 30 | '|/ |. | \| \ .\\ .\\. \ \ .\ ', 31 | ' | .| | .||. || .| | .| ', 32 | ' |. |____ ___ ______ |. || .||. | ____ ____ ____ ____ ____ |. |__ ______ ____ ___ ', 33 | ' |::|\:::|/:::\ /::::::\ |::||::||::|/::::\\:::\ \:::|\:::|/::::\ |:::::| /::::::\\:::|/:::\', 34 | ' |xx| |xx| \x||xx/ \xx||xx||xx||xx| \xx\|xx| |xx| |xx| \xx\|xx| |xx/__\xx||xx| \x|', 35 | ' |xx| |xx| |xx| |xx||xx||xx||xx| |xx||xx| |xx| |xx| |xx||xx| |xx|xxxxx||xx| ', 36 | ' |XX| |XX| |XX\__/XX||XX||XX||XX| |XX||XX\___|XX| |XX| |XX||XX\___|XX|_____ |XX| ', 37 | ' |XX| \XX\ \XXXXXX/ \XX\\XX\\XX\ \XX\ \XXXX/|XX\ \XX\ \XX\ \XXXX/ \XXXXXX/ \XX\ ', 38 | ' |XX| ', 39 | ' |XX| ', 40 | ' |XX| ', 41 | ' _|XX| ', 42 | ' \XXX| ', 43 | ' \XX| ', 44 | ' \X| ', 45 | ' \| '); 46 | 47 | { TLogo } 48 | 49 | constructor TLogo.Create; 50 | var 51 | X, Y: UInt; 52 | C: Char; 53 | begin 54 | for Y := 0 to 17 do 55 | begin 56 | FL[Y] := ''; 57 | for X := 1 to Width do 58 | begin 59 | C := T[Y][X]; 60 | case C of 61 | '_': 62 | FL[Y] := FL[Y] + Terminal.Colorize(C, 'gray'); 63 | '\', '/': 64 | FL[Y] := FL[Y] + Terminal.Colorize(C, 'dark gray'); 65 | '|': 66 | FL[Y] := FL[Y] + Terminal.Colorize(C, 'darker gray'); 67 | '.': 68 | FL[Y] := FL[Y] + Terminal.Colorize(C, 'red'); 69 | ':': 70 | FL[Y] := FL[Y] + Terminal.Colorize(C, 'light red'); 71 | 'x': 72 | FL[Y] := FL[Y] + Terminal.Colorize(C, 'orange'); 73 | 'X': 74 | FL[Y] := FL[Y] + Terminal.Colorize(C, 'light yellow'); 75 | else 76 | FL[Y] := FL[Y] + T[Y][X]; 77 | end; 78 | end; 79 | end; 80 | end; 81 | 82 | destructor TLogo.Destroy; 83 | begin 84 | 85 | inherited; 86 | end; 87 | 88 | procedure TLogo.Render(const IsSword: Boolean); 89 | var 90 | I: UInt; 91 | begin 92 | FX := Screen.Width div 2; 93 | for I := 0 to 17 do 94 | Terminal.Print(FX, I + 3, FL[I], TK_ALIGN_CENTER); 95 | if IsSword then 96 | end; 97 | 98 | function TLogo.Width: UInt; 99 | begin 100 | Result := Length(T[0]); 101 | end; 102 | 103 | initialization 104 | 105 | Logo := TLogo.Create; 106 | 107 | finalization 108 | 109 | FreeAndNil(Logo); 110 | 111 | end. 112 | -------------------------------------------------------------------------------- /sources/uSpellbook.pas: -------------------------------------------------------------------------------- 1 | unit uSpellbook; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, 6 | uCreature; 7 | 8 | type 9 | TSpellEnum = (spHeal, spTownPortal, spCurePoison, spTeleportation, 10 | spMagicEye); 11 | 12 | type 13 | TSpellBase = record 14 | Level: UInt; 15 | Effects: TEffects; 16 | Value: UInt; 17 | ManaCost: UInt; 18 | Price: UInt; 19 | end; 20 | 21 | const 22 | SpellBase: array [TSpellEnum] of TSpellBase = ( 23 | // Heal 24 | (Level: 1; Effects: [efLife]; Value: 100; ManaCost: 20; Price: 200;), 25 | // Town Portal 26 | (Level: 2; Effects: [efTownPortal]; Value: 0; ManaCost: 24; Price: 500;), 27 | // Cure Poison 28 | (Level: 2; Effects: [efCurePoison]; Value: 0; ManaCost: 30; Price: 600;), 29 | // Teleportation 30 | (Level: 3; Effects: [efTeleportation]; Value: 7; ManaCost: 40; Price: 750;), 31 | // Magic Eye 32 | (Level: 3; Effects: [efMagicEye]; Value: 20; ManaCost: 50; Price: 900;)); 33 | 34 | type 35 | TSpell = record 36 | Enable: Boolean; 37 | Spell: TSpellBase; 38 | end; 39 | 40 | type 41 | TSpellbook = class(TObject) 42 | private 43 | FSpell: array [TSpellEnum] of TSpell; 44 | public 45 | procedure Clear; 46 | function GetSpellName(ASpellEnum: TSpellEnum): string; 47 | procedure AddSpell(ASpellEnum: TSpellEnum); 48 | function GetSpell(ASpellEnum: TSpellEnum): TSpell; 49 | procedure Start; 50 | procedure DoSpell(Index: UInt); 51 | end; 52 | 53 | var 54 | Spellbook: TSpellbook = nil; 55 | 56 | implementation 57 | 58 | uses SysUtils, 59 | uLanguage, 60 | Trollhunter.Player, 61 | Trollhunter.UI.Log, 62 | Trollhunter.Statistic, 63 | Trollhunter.UI, 64 | uAttribute; 65 | 66 | { TSpellbook } 67 | 68 | procedure TSpellbook.AddSpell(ASpellEnum: TSpellEnum); 69 | begin 70 | FSpell[ASpellEnum].Enable := True; 71 | end; 72 | 73 | procedure TSpellbook.Clear; 74 | var 75 | I: TSpellEnum; 76 | begin 77 | for I := Low(TSpellEnum) to High(TSpellEnum) do 78 | FSpell[I].Enable := True; 79 | end; 80 | 81 | procedure TSpellbook.DoSpell(Index: UInt); 82 | var 83 | C: UInt; 84 | I: TSpellEnum; 85 | begin 86 | C := 0; 87 | for I := Low(TSpellEnum) to High(TSpellEnum) do 88 | if FSpell[I].Enable then 89 | begin 90 | if (Index = C) then 91 | begin 92 | if (Player.Attributes.Attrib[atMana].Value >= FSpell[I].Spell.ManaCost) 93 | then 94 | begin 95 | Player.Statictics.Inc(stSpCast); 96 | Player.Attributes.Modify(atMana, -FSpell[I].Spell.ManaCost); 97 | Player.DoEffects(FSpell[I].Spell.Effects, FSpell[I].Spell.Value); 98 | end 99 | else 100 | begin 101 | MsgLog.Add(_('You need more mana!')); 102 | Player.Calc; 103 | Player.Wait; 104 | end; 105 | Exit; 106 | end; 107 | Inc(C); 108 | end; 109 | end; 110 | 111 | function TSpellbook.GetSpell(ASpellEnum: TSpellEnum): TSpell; 112 | begin 113 | Result := FSpell[ASpellEnum]; 114 | end; 115 | 116 | function TSpellbook.GetSpellName(ASpellEnum: TSpellEnum): string; 117 | begin 118 | case ASpellEnum of 119 | spHeal: 120 | Result := _('Heal'); 121 | spTownPortal: 122 | Result := _('Town portal'); 123 | spCurePoison: 124 | Result := _('Cure poison'); 125 | spTeleportation: 126 | Result := _('Teleportation'); 127 | spMagicEye: 128 | Result := _('Magic eye'); 129 | end; 130 | end; 131 | 132 | procedure TSpellbook.Start; 133 | var 134 | I: TSpellEnum; 135 | begin 136 | Self.Clear; 137 | for I := Low(TSpellEnum) to High(TSpellEnum) do 138 | with FSpell[I].Spell do 139 | begin 140 | Level := SpellBase[I].Level; 141 | Effects := SpellBase[I].Effects; 142 | Value := SpellBase[I].Value; 143 | ManaCost := SpellBase[I].ManaCost; 144 | Price := SpellBase[I].Price; 145 | end; 146 | end; 147 | 148 | initialization 149 | 150 | Spellbook := TSpellbook.Create; 151 | 152 | finalization 153 | 154 | FreeAndNil(Spellbook); 155 | 156 | end. 157 | -------------------------------------------------------------------------------- /sources/uQuest.pas: -------------------------------------------------------------------------------- 1 | unit uQuest; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, uCreature, uMob; 6 | 7 | { TODO -cУбить существо : Убить уникального босса на локации (от первой до предпоследней). } 8 | { TODO -cУбить существо : Убить N существ на локации (от первой до последней). } 9 | { TODO -cПринести предмет : Собрать N предметов с существ на локации (от первой до последней). } 10 | { TODO -cПринести предмет : Найти уникальный предмет на локации (от первой до последней). } 11 | { TODO -cПосетить локацию : Посетить определенную локацию (от первой до последней). } 12 | { TODO -cПоговорить с НПЦ : Поговорить с определенным НПЦ (от первой до последней). } 13 | { TODO -cТаймер : Доставить предмет определенному НПЦ в указанной локации за отведенный отрезок времени (от первой до последней). } 14 | { TODO -cТаймер : Убить N существ в указанной локации за отведенный отрезок времени (от первой до последней). } 15 | 16 | type 17 | TQuestType = (qtKillMobs); 18 | 19 | type 20 | TSetOfMobEnum = set of TMobEnum; 21 | 22 | type 23 | TQuestBase = record 24 | Level: Int; 25 | QuestType: TQuestType; 26 | Mobs: TSetOfMobEnum; 27 | Amount: TMinMax; 28 | end; 29 | 30 | type 31 | TQuestEnum = (qeKillNBears); 32 | 33 | const 34 | QuestBase: array [TQuestEnum] of TQuestBase = ( 35 | // The Hunt (Kill N creatures) 36 | (Level: 1; QuestType: qtKillMobs; Mobs: [mbBlack_Bear, mbGrizzly_Bear]; 37 | Amount: (Min: 3; Max: 5;);)); 38 | 39 | type 40 | TQuestState = (qsActive, qsDone, qsFinish); 41 | 42 | type 43 | TQuest = record 44 | Level: Int; 45 | QuestState: TQuestState; 46 | QuestType: TQuestType; 47 | Mob: TMobEnum; 48 | Amount: Int; 49 | Kills: Int; 50 | end; 51 | 52 | type 53 | TQuests = class(TObject) 54 | private 55 | FCurrent: TQuestEnum; 56 | FQuest: array of TQuest; 57 | function GetQuest(I: Int): TQuest; 58 | procedure SetQuest(I: Int; const Value: TQuest); 59 | public 60 | procedure Clear(); 61 | constructor Create(); 62 | function Count(): Int; 63 | function Amount(): Int; 64 | procedure Add(const AQuestEnum: TQuestEnum); 65 | property Quest[I: Int]: TQuest read GetQuest write SetQuest; 66 | procedure DoQuest(const AQuestType: TQuestType; const Value: Int); 67 | property Current: TQuestEnum read FCurrent write FCurrent; 68 | function GetName(const AQuestEnum: TQuestEnum): string; 69 | end; 70 | 71 | var 72 | Quests: TQuests; 73 | 74 | implementation 75 | 76 | uses SysUtils, uMap, Trollhunter.UI.Log, uLanguage; 77 | 78 | { TQuests } 79 | 80 | function TQuests.GetName(const AQuestEnum: TQuestEnum): string; 81 | begin 82 | Result := 'The Hunt'; 83 | end; 84 | 85 | function TQuests.GetQuest(I: Int): TQuest; 86 | begin 87 | Result := FQuest[I] 88 | end; 89 | 90 | procedure TQuests.SetQuest(I: Int; const Value: TQuest); 91 | begin 92 | FQuest[I] := Value 93 | end; 94 | 95 | procedure TQuests.DoQuest(const AQuestType: TQuestType; const Value: Int); 96 | var 97 | I: Int; 98 | begin 99 | for I := 0 to Count() - 1 do 100 | with FQuest[I] do 101 | begin 102 | // Killing monsters 103 | if ((QuestType = AQuestType) and (QuestState = qsActive) and 104 | (Mob = TMobEnum(Value))) then 105 | Kills := Kills + 1; 106 | end; 107 | end; 108 | 109 | procedure TQuests.Add(const AQuestEnum: TQuestEnum); 110 | begin 111 | if True then 112 | begin 113 | SetLength(FQuest, Count() + 1); 114 | with FQuest[Count() - 1] do 115 | begin 116 | Level := 1; 117 | QuestState := qsActive; 118 | QuestType := qtKillMobs; 119 | Mob := mbBlack_Bear; 120 | Amount := 3; 121 | // Counters 122 | Kills := 0; 123 | end; 124 | Mobs.AddGroup(deDark_Wood, mbBlack_Bear, 3); 125 | MsgLog.Add(_('The new quest is added to the log.')); 126 | end; 127 | end; 128 | 129 | function TQuests.Amount: Int; 130 | begin 131 | Result := Ord(High(TQuestEnum)) + 1; 132 | end; 133 | 134 | procedure TQuests.Clear(); 135 | begin 136 | SetLength(FQuest, 0); 137 | end; 138 | 139 | function TQuests.Count(): Int; 140 | begin 141 | Result := Length(FQuest); 142 | end; 143 | 144 | constructor TQuests.Create(); 145 | begin 146 | Clear(); 147 | end; 148 | 149 | initialization 150 | 151 | Quests := TQuests.Create(); 152 | 153 | finalization 154 | 155 | FreeAndNil(Quests); 156 | 157 | end. 158 | -------------------------------------------------------------------------------- /sources/uCorpse.pas: -------------------------------------------------------------------------------- 1 | unit uCorpse; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | const 8 | CorpseMax = 10; 9 | 10 | type 11 | TCorpse = record 12 | X, Y, Z: UInt; 13 | end; 14 | 15 | TCorpses = class(TObject) 16 | private 17 | FCorpse: array [0 .. CorpseMax - 1] of TCorpse; 18 | procedure Save(Index, AX, AY, AZ: UInt); 19 | procedure Load(Index: UInt); 20 | public 21 | constructor Create; 22 | destructor Destroy; override; 23 | procedure Render(AX, AY: UInt); 24 | function IsCorpse(AX, AY: UInt): Boolean; 25 | procedure Append(); 26 | procedure DelCorpse(AX, AY: UInt); 27 | end; 28 | 29 | var 30 | Corpses: TCorpses = nil; 31 | 32 | implementation 33 | 34 | uses SysUtils, 35 | Trollhunter.Player, 36 | uMap, 37 | uGame, 38 | Trollhunter.Terminal; 39 | 40 | { TCorpses } 41 | 42 | procedure TCorpses.Save(Index, AX, AY, AZ: UInt); 43 | var 44 | // F: TIniFile; 45 | S: string; 46 | begin 47 | { F := TIniFile.Create(Game.GetPath() + 'morgue.thi'); 48 | try 49 | S := IntToStr(Index); 50 | F.EraseSection(S); 51 | if ((AX > 0) and (AY > 0)) then 52 | begin 53 | F.WriteInt(S, 'X', AX); 54 | F.WriteInt(S, 'Y', AY); 55 | F.WriteInt(S, 'Z', AZ); 56 | end; 57 | finally 58 | F.Free; 59 | end; } 60 | end; 61 | 62 | procedure TCorpses.Load(Index: UInt); 63 | var 64 | // F: TIniFile; 65 | S: string; 66 | begin 67 | { F := TIniFile.Create(Game.GetPath() + 'morgue.thi'); 68 | try 69 | S := IntToStr(Index); 70 | FCorpse[Index].X := F.ReadInt(S, 'X', 0); 71 | FCorpse[Index].Y := F.ReadInt(S, 'Y', 0); 72 | FCorpse[Index].Z := F.ReadInt(S, 'Z', 0); 73 | finally 74 | F.Free; 75 | end; } 76 | end; 77 | 78 | procedure TCorpses.Append; 79 | var 80 | // F: TIniFile; 81 | I: UInt; 82 | S: string; 83 | begin 84 | if (Player.X = 0) or (Player.Y = 0) or (Player.X = UIntMax) or 85 | (Player.Y = UIntMax) then 86 | Exit; 87 | { F := TIniFile.Create(Game.GetPath() + 'morgue.thi'); 88 | try 89 | for I := 0 to CorpseMax - 1 do 90 | begin 91 | S := IntToStr(I); 92 | if ((FCorpse[I].X = 0) or (FCorpse[I].Y = 0)) then 93 | F.EraseSection(S); 94 | if not F.SectionExists(S) then 95 | begin 96 | Save(I, Player.X, Player.Y, Ord(Map.Current)); 97 | Exit; 98 | end; 99 | end; 100 | finally 101 | F.Free; 102 | end; } 103 | end; 104 | 105 | constructor TCorpses.Create; 106 | // var 107 | // F: TIniFile; 108 | // I: UInt; 109 | begin 110 | { F := TIniFile.Create(Game.GetPath() + 'morgue.thi'); 111 | try 112 | for I := 0 to CorpseMax - 1 do 113 | Load(I); 114 | finally 115 | F.Free; 116 | end; } 117 | end; 118 | 119 | procedure TCorpses.DelCorpse(AX, AY: UInt); 120 | var 121 | I: UInt; 122 | begin 123 | for I := 0 to CorpseMax - 1 do 124 | begin 125 | if (UInt(Ord(Map.Current)) <> FCorpse[I].Z) then 126 | Continue; 127 | if ((FCorpse[I].X = AX) and (FCorpse[I].Y = AY)) then 128 | begin 129 | Save(I, 0, 0, 0); 130 | Load(I); 131 | Exit; 132 | end; 133 | end; 134 | end; 135 | 136 | destructor TCorpses.Destroy; 137 | begin 138 | 139 | inherited; 140 | end; 141 | 142 | function TCorpses.IsCorpse(AX, AY: UInt): Boolean; 143 | var 144 | I: UInt; 145 | begin 146 | Result := False; 147 | for I := 0 to CorpseMax - 1 do 148 | begin 149 | if (UInt(Ord(Map.Current)) <> FCorpse[I].Z) then 150 | Continue; 151 | if ((FCorpse[I].X = AX) and (FCorpse[I].Y = AY)) then 152 | begin 153 | Result := True; 154 | Exit; 155 | end; 156 | end; 157 | end; 158 | 159 | procedure TCorpses.Render(AX, AY: UInt); 160 | var 161 | Color: Cardinal; 162 | X, Y, I: UInt; 163 | begin 164 | for I := 0 to CorpseMax - 1 do 165 | begin 166 | if (UInt(Ord(Map.Current)) <> FCorpse[I].Z) then 167 | Continue; 168 | if not Map.InView(FCorpse[I].X, FCorpse[I].Y) or 169 | (not Mode.Wizard and not Map.GetFOV(FCorpse[I].X, FCorpse[I].Y)) then 170 | Continue; 171 | if ((FCorpse[I].X = 0) or (FCorpse[I].Y = 0)) then 172 | Continue; 173 | X := FCorpse[I].X - Player.X + AX + View.Left; 174 | Y := FCorpse[I].Y - Player.Y + AY + View.Top; 175 | if not Mode.Wizard and (Player.GetDist(FCorpse[I].X, FCorpse[I].Y) > 176 | Player.Vision) then 177 | Color := clFog 178 | else 179 | Color := clCorpse; 180 | Terminal.Print(X, Y, '%', Color); 181 | end; 182 | end; 183 | 184 | initialization 185 | 186 | Corpses := TCorpses.Create; 187 | 188 | finalization 189 | 190 | FreeAndNil(Corpses); 191 | 192 | end. 193 | -------------------------------------------------------------------------------- /sources/BearLibItems/uBearLibItemsCommon.pas: -------------------------------------------------------------------------------- 1 | unit uBearLibItemsCommon; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, uCreature; 6 | 7 | const 8 | BonusCount = 3; 9 | 10 | type 11 | Item = record 12 | ItemID: Int; 13 | X, Y: Int; 14 | MapID: Int; 15 | Level: UInt; 16 | Identify: Int; 17 | Stack: Int; 18 | Amount: Int; 19 | MinDamage: Int; 20 | MaxDamage: Int; 21 | Defense: Int; 22 | Durability: Int; 23 | MaxDurability: Int; 24 | Weight: Int; 25 | Size: Int; 26 | SlotID: Int; 27 | Equipment: Int; 28 | Price: Int; 29 | Bonus: array [0 .. BonusCount - 1] of Cardinal; 30 | Color: Cardinal; 31 | Effects: TEffects; 32 | Value: Int; 33 | end; 34 | 35 | type 36 | TItems = array of Item; 37 | 38 | const 39 | IntFalse = 0; 40 | IntTrue = 1; 41 | 42 | // Library 43 | procedure Items_Open(); stdcall; 44 | procedure Items_Close(); stdcall; 45 | function Items_GetVersion(): PWideChar; stdcall; 46 | 47 | // Add 48 | procedure Items_Clear_Item(var AItem: Item); 49 | 50 | // Common 51 | function HasItem(AItems: TItems; Index, AMapID: Int): Boolean; overload; 52 | function HasItem(AItems: TItems; Index, AMapID: Int; AX, AY: Int) 53 | : Boolean; overload; 54 | function IndexInRange(AItems: TItems; Index: Int): Boolean; 55 | procedure AddItem(var AItems: TItems; AItem: Item); 56 | function DelItem(var AItems: TItems; Index: Int): Item; 57 | function HasEmpty(AItems: TItems): Boolean; 58 | procedure Empty(var AItems: TItems); 59 | function GlobalIndex(AItems: TItems; MapID, Index: Int; AX: Int = -1; 60 | AY: Int = -1): Int; 61 | 62 | implementation 63 | 64 | uses uBearLibItemsDungeon, uBearLibItemsInventory; 65 | 66 | const 67 | LibVersion = '0.4.0'; 68 | 69 | // Library 70 | 71 | procedure Items_Open(); stdcall; 72 | begin 73 | Items_Dungeon_Clear(); 74 | Items_Inventory_Clear(); 75 | end; 76 | 77 | procedure Items_Close(); stdcall; 78 | begin 79 | Items_Dungeon_Clear(); 80 | Items_Inventory_Clear(); 81 | end; 82 | 83 | function Items_GetVersion(): PWideChar; stdcall; 84 | begin 85 | Result := LibVersion; 86 | end; 87 | 88 | // Add 89 | 90 | procedure Items_Clear_Item(var AItem: Item); 91 | var 92 | I: Int; 93 | begin 94 | with AItem do 95 | begin 96 | ItemID := -1; 97 | X := -1; 98 | Y := -1; 99 | MapID := -1; 100 | Level := 1; 101 | Identify := -1; 102 | Stack := 1; 103 | Amount := 1; 104 | MinDamage := 0; 105 | MaxDamage := 0; 106 | Defense := 0; 107 | Durability := 0; 108 | MaxDurability := 0; 109 | Weight := 1; 110 | Size := 1; 111 | SlotID := 0; 112 | Equipment := 0; 113 | Price := 0; 114 | for I := 0 to BonusCount - 1 do 115 | Bonus[I] := 0; 116 | Color := $FFFFFFFF; 117 | Effects := []; 118 | Value := 0; 119 | end; 120 | end; 121 | 122 | // Common 123 | 124 | function HasItem(AItems: TItems; Index, AMapID: Int): Boolean; 125 | begin 126 | Result := (AItems[Index].MapID = AMapID); 127 | end; 128 | 129 | function HasItem(AItems: TItems; Index, AMapID: Int; 130 | AX, AY: Int): Boolean; 131 | begin 132 | if (AX = -1) and (AY = -1) then 133 | Result := HasItem(AItems, Index, AMapID) 134 | else 135 | Result := (AItems[Index].MapID = AMapID) and (AItems[Index].X = AX) and 136 | (AItems[Index].Y = AY); 137 | end; 138 | 139 | function IndexInRange(AItems: TItems; Index: Int): Boolean; 140 | begin 141 | Result := (Index >= 0) and (Index < Length(AItems)); 142 | end; 143 | 144 | procedure AddItem(var AItems: TItems; AItem: Item); 145 | begin 146 | // if (Length(AItems) <= Items_Inventory_GetSlotCount) then 147 | // begin 148 | SetLength(AItems, Length(AItems) + 1); 149 | AItems[Length(AItems) - 1] := AItem; 150 | { .. } 151 | // end else begin 152 | 153 | // end; 154 | end; 155 | 156 | function DelItem(var AItems: TItems; Index: Int): Item; 157 | var 158 | I: Int; 159 | begin 160 | Result := AItems[Index]; 161 | if (Length(AItems) > 1) then 162 | for I := Index to Length(AItems) - 2 do 163 | AItems[I] := AItems[I + 1]; 164 | SetLength(AItems, Length(AItems) - 1); 165 | end; 166 | 167 | function HasEmpty(AItems: TItems): Boolean; 168 | begin 169 | Result := (Length(AItems) = 0); 170 | end; 171 | 172 | procedure Empty(var AItems: TItems); 173 | begin 174 | SetLength(AItems, 0); 175 | end; 176 | 177 | function GlobalIndex(AItems: TItems; MapID, Index: Int; AX: Int = -1; 178 | AY: Int = -1): Int; 179 | var 180 | I, P: Int; 181 | begin 182 | Result := -1; 183 | if HasEmpty(AItems) then 184 | Exit; 185 | if not IndexInRange(AItems, Index) then 186 | Exit; 187 | P := 0; 188 | for I := 0 to Length(AItems) - 1 do 189 | if HasItem(AItems, I, MapID, AX, AY) then 190 | begin 191 | if (P = Index) then 192 | begin 193 | Result := I; 194 | Exit; 195 | end; 196 | Inc(P); 197 | end; 198 | end; 199 | 200 | end. 201 | -------------------------------------------------------------------------------- /sources/uCalendar.pas: -------------------------------------------------------------------------------- 1 | unit uCalendar; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | type 8 | TCalendar = class(TObject) 9 | private 10 | FMinute: UInt; 11 | FHour: UInt; 12 | FDay: UInt; 13 | FDayOfWeek: UInt; 14 | FMonth: UInt; 15 | FYear: UInt; 16 | public 17 | constructor Create(const ADay, AMonth: UInt; const AYear: UInt); 18 | property Minute: UInt read FMinute; 19 | property Hour: UInt read FHour; 20 | property Day: UInt read FDay; 21 | property DayOfWeek: UInt read FDayOfWeek; 22 | property Month: UInt read FMonth; 23 | property Year: UInt read FYear; 24 | function DaysPerMonth(AMonth: UInt): UInt; 25 | function DaysThisMonth(): UInt; 26 | function GetMonthName(AMonth: UInt = 0): string; 27 | function GetDayName(): string; 28 | function GetTime(): string; 29 | function GetTimeStr(): string; 30 | function IsDay: Boolean; 31 | procedure OnHour(); 32 | procedure OnDay(); 33 | procedure OnWeek(); 34 | procedure OnMonth(); 35 | procedure OnYear(); 36 | procedure Turn(); 37 | end; 38 | 39 | var 40 | Calendar: TCalendar; 41 | 42 | implementation 43 | 44 | uses SysUtils, 45 | Math, 46 | uLanguage, 47 | uItem, 48 | Trollhunter.Item.Shop, 49 | Trollhunter.UI.Log, 50 | Trollhunter.Player, 51 | uCreature, 52 | uAttribute, 53 | uHelpers; 54 | 55 | { TCalendar } 56 | 57 | constructor TCalendar.Create(const ADay, AMonth: UInt; const AYear: UInt); 58 | begin 59 | Randomize(); 60 | FMinute := Math.RandomRange(0, 60); 61 | FHour := Math.RandomRange(9, 18); 62 | FDay := ADay; 63 | FDayOfWeek := ADay; 64 | FMonth := AMonth; 65 | FYear := AYear; 66 | end; 67 | 68 | function TCalendar.DaysPerMonth(AMonth: UInt): UInt; 69 | const 70 | DaysInMonth: array [1 .. 12] of UInt = (31, 28, 31, 30, 31, 30, 31, 31, 30, 71 | 31, 30, 31); 72 | begin 73 | Result := DaysInMonth[AMonth]; 74 | end; 75 | 76 | function TCalendar.DaysThisMonth(): UInt; 77 | begin 78 | Result := DaysPerMonth(Month) 79 | end; 80 | 81 | function TCalendar.GetDayName(): string; 82 | const 83 | DayName: array [1 .. 7] of string = ('Monday', 'Tuesday', 'Wednesday', 84 | 'Thursday', 'Friday', 'Saturday', 'Sunday'); 85 | begin 86 | Result := DayName[DayOfWeek]; 87 | end; 88 | 89 | function TCalendar.GetMonthName(AMonth: UInt): string; 90 | const 91 | MonthName: array [1 .. 12] of string = ('January', 'February', 'March', 92 | 'April', 'May', 'June', 'July', 'August', 'September', 'October', 93 | 'November', 'December'); 94 | begin 95 | if (AMonth = 0) then 96 | AMonth := FMonth; 97 | Result := MonthName[AMonth]; 98 | end; 99 | 100 | function TCalendar.GetTime(): string; 101 | begin 102 | Result := Format('%d:%d', [Hour, Minute]); 103 | end; 104 | 105 | function TCalendar.GetTimeStr(): string; 106 | begin 107 | case Hour of 108 | 6 .. 8: 109 | Result := _('Morning'); 110 | 9 .. 18: 111 | Result := _('Day'); 112 | 19 .. 21: 113 | Result := _('Evening'); 114 | else 115 | Result := _('Night'); 116 | end; 117 | end; 118 | 119 | function TCalendar.IsDay: Boolean; 120 | begin 121 | Result := (Hour >= 6) and (Hour <= 21); 122 | end; 123 | 124 | procedure TCalendar.OnDay(); 125 | begin 126 | end; 127 | 128 | procedure TCalendar.OnHour(); 129 | begin 130 | // Replenish Life 131 | if (Player.Attributes.Attrib[atReLife].Value > 0) then 132 | Player.Attributes.Modify(atLife, Player.Attributes.Attrib[atReLife] 133 | .Value.InRange(ReLifeMax)); 134 | // Regenerate Mana 135 | if (Player.Attributes.Attrib[atReMana].Value > 0) then 136 | Player.Attributes.Modify(atMana, Player.Attributes.Attrib[atReMana] 137 | .Value.InRange(ReManaMax)); 138 | end; 139 | 140 | procedure TCalendar.OnMonth(); 141 | begin 142 | 143 | end; 144 | 145 | procedure TCalendar.OnWeek(); 146 | begin 147 | Shops.New(); 148 | Items.DelCorpses(); 149 | Items.AddPlants(); 150 | end; 151 | 152 | procedure TCalendar.OnYear(); 153 | begin 154 | 155 | end; 156 | 157 | procedure TCalendar.Turn(); 158 | begin 159 | Inc(FMinute); 160 | if (Minute > SysUtils.MinsPerHour - 1) then 161 | begin 162 | FMinute := Minute - SysUtils.MinsPerHour; 163 | Inc(FHour); 164 | OnHour(); 165 | end; 166 | if (Hour > SysUtils.HoursPerDay - 1) then 167 | begin 168 | FHour := 0; 169 | Inc(FDay); 170 | Inc(FDayOfWeek); 171 | OnDay(); 172 | end; 173 | if (DayOfWeek > 7) then 174 | begin 175 | FDayOfWeek := 1; 176 | OnWeek(); 177 | end; 178 | if (Day > DaysThisMonth) then 179 | begin 180 | FDay := 1; 181 | Inc(FMonth); 182 | OnMonth(); 183 | end; 184 | if (Month > 12) then 185 | begin 186 | FMonth := 1; 187 | Inc(FYear); 188 | OnYear(); 189 | end; 190 | end; 191 | 192 | initialization 193 | 194 | Calendar := TCalendar.Create(1, 1, 1297); 195 | 196 | finalization 197 | 198 | FreeAndNil(Calendar); 199 | 200 | end. 201 | -------------------------------------------------------------------------------- /sources/Trollhunter.Player.Classes.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Player.Classes; 2 | 3 | interface 4 | 5 | uses 6 | Trollhunter.Types, 7 | Trollhunter.Item.Types, 8 | Trollhunter.Player.Types, 9 | uCreature, 10 | uSkill; 11 | 12 | type 13 | TClassEnum = (clWarrior, clMage, clRanger, clThief); 14 | 15 | type 16 | TClassSkillEnum = (skWeapon, skMain, skAdd); 17 | 18 | type 19 | TClassProp = record 20 | Description: string; 21 | Strength: TMinMax; 22 | Dexterity: TMinMax; 23 | Willpower: TMinMax; 24 | Perception: TMinMax; 25 | Life: TMinMax; 26 | Mana: TMinMax; 27 | Skill: array [TClassSkillEnum] of TSkillEnum; 28 | Item: array [stHead .. stFinger] of TItemEnum; 29 | end; 30 | 31 | const 32 | ClassProp: array [TClassEnum] of TClassProp = ( 33 | // Warrior 34 | (Description: 'Warrior'; Strength: (Min: 1; Max: 4;); Dexterity: (Min: 1; 35 | Max: 2;); Willpower: (Min: 0; Max: 0;); Perception: (Min: 0; Max: 0;); 36 | Life: (Min: 10; Max: 15;); Mana: (Min: 0; Max: 0;); 37 | Skill: (skBlade, skAthletics, skBodybuilding); 38 | Item: (ivCap, ivQuilted_Armor, None, None, ivRusty_Sword, ivBuckler, 39 | None, None);), 40 | // Mage 41 | (Description: 'Mage'; Strength: (Min: 0; Max: 0;); Dexterity: (Min: 0; 42 | Max: 0;); Willpower: (Min: 1; Max: 4;); Perception: (Min: 1; Max: 2;); 43 | Life: (Min: 0; Max: 0;); Mana: (Min: 15; Max: 25;); 44 | Skill: (skStaff, skConcentration, skMeditation); 45 | Item: (ivHood, ivLight_Clothes, None, None, ivQuarterstaff, None, 46 | None, None);), 47 | // Ranger 48 | (Description: 'Ranger'; Strength: (Min: 1; Max: 2;); Dexterity: (Min: 1; 49 | Max: 4;); Willpower: (Min: 0; Max: 0;); Perception: (Min: 0; Max: 0;); 50 | Life: (Min: 5; Max: 10;); Mana: (Min: 1; Max: 5;); 51 | Skill: (skBow, skDodge, skDodge); Item: (ivCap, ivQuilted_Armor, None, None, 52 | ivBow1, None, None, None);), 53 | // Thief 54 | (Description: 'Thief'; Strength: (Min: 0; Max: 0;); Dexterity: (Min: 1; 55 | Max: 2;); Willpower: (Min: 0; Max: 0;); Perception: (Min: 1; Max: 4;); 56 | Life: (Min: 5; Max: 7;); Mana: (Min: 5; Max: 7;); 57 | Skill: (skDagger, skToughness, skStealth); 58 | Item: (ivCap, ivQuilted_Armor, None, None, ivDagger1, None, None, None);) 59 | /// /// 60 | ); 61 | 62 | type 63 | TClasses = class(TObject) 64 | private 65 | FSkills: TSkills; 66 | FClassName: array [TClassEnum] of string; 67 | public 68 | constructor Create; 69 | destructor Destroy; override; 70 | function GetName(I: TClassEnum): string; 71 | function GetDescription(I: TClassEnum): string; 72 | function GetSkills(I: TClassEnum): string; 73 | function GetItems(I: TClassEnum): string; 74 | function GetSkillBeginValue(ClassSkillEnum: TClassSkillEnum): UInt; 75 | end; 76 | 77 | var 78 | Classes: TClasses; 79 | 80 | implementation 81 | 82 | uses SysUtils, 83 | TypInfo, 84 | uHelpers, 85 | Trollhunter.Utils, 86 | uItem; 87 | 88 | { TClasses } 89 | 90 | constructor TClasses.Create; 91 | var 92 | I: TClassEnum; 93 | P: Pointer; 94 | begin 95 | P := TypeInfo(TClassEnum); 96 | for I := Low(TClassEnum) to High(TClassEnum) do 97 | FClassName[I] := GetEnumName(P, Ord(I)).GetName('cl'); 98 | FSkills := TSkills.Create; 99 | end; 100 | 101 | destructor TClasses.Destroy; 102 | begin 103 | FreeAndNil(FSkills); 104 | inherited; 105 | end; 106 | 107 | function TClasses.GetDescription(I: TClassEnum): string; 108 | begin 109 | Result := ClassProp[I].Description; 110 | end; 111 | 112 | function TClasses.GetItems(I: TClassEnum): string; 113 | var 114 | J: TSlotType; 115 | F: Boolean; 116 | S: string; 117 | begin 118 | F := False; 119 | Result := ''; 120 | for J := Low(ClassProp[I].Item) to High(ClassProp[I].Item) do 121 | if (ClassProp[I].Item[J] <> TItemEnum.None) then 122 | begin 123 | S := Items.Name[ClassProp[I].Item[J]]; 124 | Utils.AppStr(Result, S, F); 125 | F := True; 126 | end; 127 | end; 128 | 129 | function TClasses.GetName(I: TClassEnum): string; 130 | begin 131 | Result := FClassName[I] 132 | end; 133 | 134 | function TClasses.GetSkillBeginValue(ClassSkillEnum: TClassSkillEnum): UInt; 135 | begin 136 | case ClassSkillEnum of 137 | skWeapon, skMain: 138 | Result := BeginSkill; 139 | else 140 | Result := StartSkill; 141 | end; 142 | end; 143 | 144 | function TClasses.GetSkills(I: TClassEnum): string; 145 | var 146 | J: TClassSkillEnum; 147 | F: Boolean; 148 | S: string; 149 | begin 150 | F := False; 151 | Result := ''; 152 | for J := Low(TClassSkillEnum) to High(TClassSkillEnum) do 153 | begin 154 | S := Format('%s +%d', [FSkills.GetName(ClassProp[I].Skill[J]), 155 | GetSkillBeginValue(J)]); 156 | Utils.AppStr(Result, S, F); 157 | F := True; 158 | end; 159 | end; 160 | 161 | initialization 162 | 163 | Classes := TClasses.Create; 164 | 165 | finalization 166 | 167 | FreeAndNil(Classes); 168 | 169 | end. 170 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.Help.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.Help; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, 6 | uScenes; 7 | 8 | type 9 | TSceneHelp = class(TScene) 10 | public 11 | constructor Create; 12 | destructor Destroy; override; 13 | procedure Render; override; 14 | procedure Update(var Key: UInt); override; 15 | end; 16 | 17 | implementation 18 | 19 | { TSceneHelp } 20 | 21 | uses SysUtils, 22 | uLanguage, 23 | Trollhunter.UI, 24 | BearLibTerminal, 25 | Trollhunter.Terminal; 26 | 27 | constructor TSceneHelp.Create; 28 | begin 29 | 30 | end; 31 | 32 | destructor TSceneHelp.Destroy; 33 | begin 34 | 35 | inherited; 36 | end; 37 | 38 | procedure TSceneHelp.Render; 39 | begin 40 | UI.Title(_('Help')); 41 | 42 | case Scenes.PrevSceneEnum of 43 | scClass: 44 | begin 45 | UI.Title(_('Keybindings'), 5); 46 | X := 1; 47 | Y := 7; 48 | AddLine('Space', _('Re-roll')); 49 | AddLine('Backspace', _('Random')); 50 | AddLine('A-Z', _('Select a class')); 51 | end; 52 | scRace: 53 | begin 54 | UI.Title(_('Keybindings'), 5); 55 | X := 1; 56 | Y := 7; 57 | AddLine('Tab', _('Choose a sex')); 58 | AddLine('Space', _('Re-roll')); 59 | AddLine('Backspace', _('Random')); 60 | AddLine('A-Z', _('Select a race')); 61 | end; 62 | scInv: 63 | begin 64 | Terminal.Print(CX, 3, 65 | Format(_('To drop an item, press the %s key and then press %s key to drop it.'), 66 | [UI.KeyToStr('TAB'), UI.KeyToStr('A-Z')]), TK_ALIGN_CENTER); 67 | 68 | UI.Title(_('Keybindings'), 5); 69 | X := 1; 70 | Y := 7; 71 | AddLine('Tab', _('Drop an item to the floor')); 72 | AddLine('Space', _('Character Screen')); 73 | AddLine('A-Z', _('Use an item')); 74 | end; 75 | scPlayer: 76 | begin 77 | UI.Title(_('Keybindings'), 5); 78 | 79 | X := 1; 80 | Y := 8; 81 | AddLine('Right/Left', _('Change tab')); 82 | AddLine('Up/Down', _('Scroll skills')); 83 | AddLine('Tab', _('Show Background')); 84 | AddLine('Space', _('Show Inventory')); 85 | end; 86 | scGame: 87 | begin 88 | Terminal.Print(CX, 3, 89 | _('Far away in an uncharted region of the Earth land Elvion lies surrounded by mountains.'), 90 | TK_ALIGN_CENTER); 91 | Terminal.Print(CX, 4, 92 | _('In the center of this land there is a village named Dork. It''s people are in'), 93 | TK_ALIGN_CENTER); 94 | Terminal.Print(CX, 5, 95 | _('grave danger as the Troll King and his armies are marching to lay waste on all of'), 96 | TK_ALIGN_CENTER); 97 | Terminal.Print(CX, 6, 98 | _('its inhabitants. Unless a hero will rise to take a stand against the forces of evil.'), 99 | TK_ALIGN_CENTER); 100 | 101 | Terminal.Print(CX, 8, 102 | _('You are the hero who departs on a quest to stop the enemies and save your homeland,'), 103 | TK_ALIGN_CENTER); 104 | Terminal.Print(CX, 9, 105 | _('Elvion. Survive, gather equipment, fight adversaries and be ready for the final'), 106 | TK_ALIGN_CENTER); 107 | Terminal.Print(CX, 10, _('confrontation. Good luck! You will need it.'), 108 | TK_ALIGN_CENTER); 109 | 110 | UI.Title(_('Keybindings'), 12); 111 | 112 | Terminal.Print(CX, 14, Format('%s: %s, %s, %s %s: %s, %s %s: %s', 113 | [_('Move'), UI.KeyToStr('arrow keys'), UI.KeyToStr('numpad'), 114 | UI.KeyToStr('QWEADZXC'), _('Wait'), UI.KeyToStr('5'), 115 | UI.KeyToStr('S'), _('Effects'), UI.KeyToStr('TAB')]), 116 | TK_ALIGN_CENTER); 117 | 118 | X := 1; 119 | Y := 16; 120 | AddLine('<', _('Go up stairs')); 121 | AddLine('>', _('Go down stairs')); 122 | AddLine('G', _('Pick up an item from the floor')); 123 | AddLine('F', _('Drop an item to the floor')); 124 | AddLine('L', _('Look mode')); 125 | AddLine('R', _('Rest')); 126 | AddLine('M', _('View messages')); 127 | // AddLine('B', _('Spellbook')); 128 | AddLine('T', _('Talents')); 129 | AddLine('N', _('Show Statistics')); 130 | AddLine('O', _('Options')); 131 | AddLine('I', _('Show Inventory')); 132 | AddLine('P', _('Character Screen')); 133 | AddLine('K', _('Calendar')); 134 | AddLine('?', _('Show this Help Screen')); 135 | 136 | UI.Title(_('Character dump'), Terminal.Window.Height - 6); 137 | Terminal.Print(CX, Terminal.Window.Height - 4, 138 | Format(_('The game saves a character dump to %s file.'), 139 | [UI.KeyToStr('*-character-dump.txt')]), TK_ALIGN_CENTER); 140 | end; 141 | end; 142 | Self.AddKey('Esc', _('Close'), True); 143 | end; 144 | 145 | procedure TSceneHelp.Update(var Key: UInt); 146 | begin 147 | case Key of 148 | TK_ESCAPE: 149 | // Close 150 | Scenes.GoBack; 151 | end; 152 | end; 153 | 154 | end. 155 | -------------------------------------------------------------------------------- /sources/BearLibPathFind/uPathFind.pas: -------------------------------------------------------------------------------- 1 | unit uPathFind; // By KIPAR 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | type 8 | TGetXYVal = function(X, Y: Int): Boolean; stdcall; 9 | 10 | function PathFind(MapX, MapY, FromX, FromY, ToX, ToY: Int; 11 | Callback: TGetXYVal; var TargetX, TargetY: Int): Boolean; 12 | 13 | implementation 14 | 15 | uses Math; 16 | 17 | const 18 | MAXLEN = 1000; 19 | KNORM = 10; 20 | KDIAG = 12; 21 | 22 | type 23 | TUIntPoint = record 24 | X, Y: UInt; 25 | end; 26 | 27 | type 28 | TPathFindBlock = record 29 | CostWay: Int; 30 | Parent: TUIntPoint; 31 | end; 32 | 33 | type 34 | TOpenBlock = record 35 | Cost, X, Y: Int; 36 | end; 37 | 38 | POpenBlock = ^TOpenBlock; 39 | 40 | TPathFindMap = array of TPathFindBlock; 41 | 42 | var 43 | Cells: TPathFindMap; 44 | FAULT: Int; 45 | SavedMapX, SavedMapY: Int; 46 | Open: array [0 .. MAXLEN] of POpenBlock; 47 | OpenRaw: array [0 .. MAXLEN] of TOpenBlock; 48 | 49 | procedure InitCrap; 50 | var 51 | I: Int; 52 | begin 53 | for I := 0 to MAXLEN do 54 | Open[I] := @OpenRaw[I]; 55 | end; 56 | 57 | function Heuristic(dx, dy: Int): Int; 58 | begin 59 | Result := KNORM * Max(dx, dy) + (KDIAG - KNORM) * Min(dx, dy); 60 | end; 61 | 62 | var 63 | NOpen: Int = 0; 64 | 65 | function PathFind(MapX, MapY, FromX, FromY, ToX, ToY: Int; 66 | Callback: TGetXYVal; var TargetX, TargetY: Int): Boolean; 67 | 68 | procedure HeapSwap(I, j: Int); 69 | var 70 | tmp: POpenBlock; 71 | begin 72 | tmp := Open[I]; 73 | Open[I] := Open[j]; 74 | Open[j] := tmp; 75 | end; 76 | 77 | procedure HeapAdd; 78 | var 79 | I, Parent: Int; 80 | begin 81 | I := NOpen - 1; 82 | Parent := (I - 1) div 2; 83 | while (I > 0) and (Open[Parent].Cost > Open[I].Cost) do 84 | begin 85 | HeapSwap(I, Parent); 86 | I := Parent; 87 | Parent := (I - 1) div 2; 88 | end; 89 | end; 90 | 91 | procedure Heapify(I: Int); 92 | var 93 | leftChild, rightChild, largestChild: Int; 94 | begin 95 | repeat 96 | leftChild := 2 * I + 1; 97 | if leftChild >= NOpen then 98 | exit; 99 | rightChild := leftChild + 1; 100 | largestChild := I; 101 | if Open[leftChild].Cost < Open[largestChild].Cost then 102 | largestChild := leftChild; 103 | if (rightChild < NOpen) and 104 | (Open[rightChild].Cost < Open[largestChild].Cost) then 105 | largestChild := rightChild; 106 | if largestChild = I then 107 | exit; 108 | HeapSwap(I, largestChild); 109 | I := largestChild; 110 | until false; 111 | end; 112 | 113 | procedure AddToOpen(X, Y, FrX, FrY, NewCost: Int); 114 | begin 115 | if not InRange(X, 0, MapX - 1) then 116 | exit; 117 | if not InRange(Y, 0, MapY - 1) then 118 | exit; 119 | with Cells[X * MapY + Y] do 120 | begin 121 | if CostWay > 0 then // if OpenID > 0 then 122 | begin 123 | // if CostWay <= NewCost then 124 | exit; 125 | end; 126 | if not Callback(X, Y) then 127 | exit; 128 | if NOpen >= MAXLEN then 129 | exit; 130 | Open[NOpen].X := X; 131 | Open[NOpen].Y := Y; 132 | // TODO?? 133 | CostWay := NewCost; 134 | Open[NOpen].Cost := CostWay + Heuristic(abs(X - FromX), abs(Y - FromY)); 135 | Inc(NOpen); 136 | HeapAdd; 137 | Parent.X := FrX; 138 | Parent.Y := FrY; 139 | end; 140 | end; 141 | 142 | var 143 | CurX, CurY: Int; 144 | begin 145 | Result := false; 146 | if not InRange(ToX, 0, MapX - 1) then 147 | exit; 148 | if not InRange(ToY, 0, MapY - 1) then 149 | exit; 150 | if not Callback(ToX, ToY) then 151 | exit; 152 | // if not Callback(FromX, FromY) then exit; 153 | if (FromX = ToX) and (FromY = ToY) then 154 | begin 155 | Result := True; 156 | TargetX := ToX; 157 | TargetY := ToY; 158 | exit; 159 | end; 160 | 161 | if (SavedMapX <> MapX) or (SavedMapY <> MapY) then 162 | begin 163 | SetLength(Cells, 0); 164 | SetLength(Cells, MapX * MapY); 165 | SavedMapX := MapX; 166 | SavedMapY := MapY; 167 | end 168 | else 169 | begin 170 | FillChar(Pointer(Cells)^, MapX * MapY * Sizeof(Cells[0]), 0); 171 | end; 172 | // exit; 173 | 174 | NOpen := 0; 175 | // FillChar(Cells, SizeOf(Cells), 0); 176 | AddToOpen(ToX, ToY, -1, -1, 0); 177 | repeat 178 | CurX := Open[0].X; 179 | CurY := Open[0].Y; 180 | if (CurX = FromX) and (CurY = FromY) then 181 | begin 182 | Result := True; 183 | // Inc(TOTAL, Open[0].Cost); 184 | with Cells[CurX * MapY + CurY] do 185 | begin 186 | TargetX := Parent.X; 187 | TargetY := Parent.Y; 188 | end; 189 | exit; 190 | end; 191 | with Cells[CurX * MapY + CurY] do 192 | begin 193 | // IsClosed := True; 194 | // inc(CHECKED); 195 | HeapSwap(0, NOpen - 1); 196 | // Open[0] := Open[NOpen-1]; 197 | Dec(NOpen); 198 | Heapify(0); 199 | AddToOpen(CurX - 1, CurY, CurX, CurY, CostWay + KNORM); 200 | AddToOpen(CurX, CurY - 1, CurX, CurY, CostWay + KNORM); 201 | AddToOpen(CurX, CurY + 1, CurX, CurY, CostWay + KNORM); 202 | AddToOpen(CurX + 1, CurY, CurX, CurY, CostWay + KNORM); 203 | AddToOpen(CurX - 1, CurY - 1, CurX, CurY, CostWay + KDIAG); 204 | AddToOpen(CurX - 1, CurY + 1, CurX, CurY, CostWay + KDIAG); 205 | AddToOpen(CurX + 1, CurY - 1, CurX, CurY, CostWay + KDIAG); 206 | AddToOpen(CurX + 1, CurY + 1, CurX, CurY, CostWay + KDIAG); 207 | if NOpen > FAULT then 208 | FAULT := NOpen; 209 | end; 210 | until NOpen <= 0; 211 | Result := false; 212 | end; 213 | 214 | initialization 215 | 216 | InitCrap; 217 | 218 | end. 219 | -------------------------------------------------------------------------------- /sources/Trollhunter.Item.Shop.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Item.Shop; 2 | 3 | interface 4 | 5 | uses 6 | Trollhunter.Types, 7 | uBeaRLibItemsCommon, 8 | Trollhunter.Player, 9 | uItem; 10 | 11 | type 12 | TShopEnum = (shPotions, shScrolls, shHealer, shMana, shSmith, shArmors, 13 | shGloves, shFoods, shWeapons, shBoots, shTavern, shShields, shHelms, 14 | shJewelry, shGem, shRunes); 15 | 16 | type 17 | TItemsStore = array [0 .. ItemMax - 1] of Item; 18 | 19 | type 20 | TShop = class 21 | private 22 | FItemsStore: TItemsStore; 23 | FCount: UInt; 24 | public 25 | constructor Create; 26 | procedure Clear; 27 | property Count: UInt read FCount; 28 | procedure Add(const AItem: Item); 29 | function GetItem(const Index: UInt): Item; 30 | end; 31 | 32 | type 33 | TShops = class 34 | FCurrent: TShopEnum; 35 | FShop: array [TShopEnum] of TShop; 36 | function GetShop(I: TShopEnum): TShop; 37 | procedure SetShop(I: TShopEnum; const Value: TShop); 38 | public 39 | constructor Create; 40 | destructor Destroy; override; 41 | procedure New; 42 | procedure Clear; 43 | procedure Render; 44 | function Count: UInt; 45 | property Current: TShopEnum read FCurrent write FCurrent; 46 | property Shop[I: TShopEnum]: TShop read GetShop write SetShop; 47 | end; 48 | 49 | var 50 | Shops: TShops; 51 | 52 | implementation 53 | 54 | uses 55 | SysUtils, 56 | Math, 57 | uMap, 58 | uCreature, 59 | uAttribute, 60 | uHelpers, 61 | Trollhunter.Item.Types; 62 | 63 | { TShop } 64 | 65 | procedure TShop.Add(const AItem: Item); 66 | begin 67 | FItemsStore[FCount] := AItem; 68 | Inc(FCount); 69 | end; 70 | 71 | procedure TShop.Clear; 72 | var 73 | I: UInt; 74 | begin 75 | for I := Low(FItemsStore) to High(FItemsStore) do 76 | Items_Clear_Item(FItemsStore[I]); 77 | FCount := 0; 78 | end; 79 | 80 | constructor TShop.Create; 81 | begin 82 | Self.Clear; 83 | end; 84 | 85 | function TShop.GetItem(const Index: UInt): Item; 86 | begin 87 | Result := FItemsStore[Index.InRange(ItemMax)]; 88 | end; 89 | 90 | { TShops } 91 | 92 | procedure TShops.Clear; 93 | var 94 | S: TShopEnum; 95 | begin 96 | for S := Low(TShopEnum) to High(TShopEnum) do 97 | FShop[S].Clear; 98 | end; 99 | 100 | function TShops.Count: UInt; 101 | begin 102 | Result := Length(FShop); 103 | end; 104 | 105 | constructor TShops.Create; 106 | var 107 | S: TShopEnum; 108 | begin 109 | for S := Low(TShopEnum) to High(TShopEnum) do 110 | FShop[S] := TShop.Create; 111 | Current := shPotions; 112 | end; 113 | 114 | destructor TShops.Destroy; 115 | var 116 | S: TShopEnum; 117 | begin 118 | for S := Low(TShopEnum) to High(TShopEnum) do 119 | FreeAndNil(FShop[S]); 120 | inherited; 121 | end; 122 | 123 | function TShops.GetShop(I: TShopEnum): TShop; 124 | begin 125 | Result := FShop[I]; 126 | end; 127 | 128 | procedure TShops.New; 129 | var 130 | FItem: Item; 131 | I, Max: UInt; 132 | ID: TItemEnum; 133 | S: TShopEnum; 134 | 135 | function GetItemID(): TItemEnum; 136 | begin 137 | Result := TItemEnum(Math.RandomRange(Ord(Low(TItemEnum)), 138 | Ord(High(TItemEnum)) + 1)); 139 | end; 140 | 141 | function Check: Boolean; 142 | var 143 | Effects: TEffects; 144 | begin 145 | ID := GetItemID(); 146 | Effects := ItemBase[ID].Effects; 147 | case S of 148 | shTavern: 149 | Result := ID in TavernItems; 150 | shHealer: 151 | Result := efLife in Effects; 152 | shMana: 153 | Result := (efMana in Effects) and not(efLife in Effects); 154 | shPotions: 155 | Result := ItemBase[ID].ItemType in PotionTypeItems; 156 | shScrolls: 157 | Result := ItemBase[ID].ItemType in ScrollTypeItems; 158 | shArmors: 159 | Result := ItemBase[ID].ItemType in ArmorTypeItems; 160 | shGloves: 161 | Result := ItemBase[ID].ItemType in GlovesTypeItems; 162 | shBoots: 163 | Result := ItemBase[ID].ItemType in BootsTypeItems; 164 | shHelms: 165 | Result := ItemBase[ID].ItemType in HelmTypeItems; 166 | shShields: 167 | Result := ItemBase[ID].ItemType in ShieldTypeItems; 168 | shWeapons: 169 | Result := ItemBase[ID].ItemType in WeaponTypeItems; 170 | shSmith: 171 | Result := ItemBase[ID].ItemType in SmithTypeItems + RepairTypeItems; 172 | shFoods: 173 | Result := ItemBase[ID].ItemType in FoodTypeItems + PlantTypeItems; 174 | shGem: 175 | Result := ItemBase[ID].ItemType in GemTypeItems; 176 | shJewelry: 177 | Result := ItemBase[ID].ItemType in JewelryTypeItems; 178 | shRunes: 179 | Result := ItemBase[ID].ItemType in RuneTypeItems; 180 | else 181 | Result := False; 182 | end; 183 | end; 184 | 185 | begin 186 | for S := Low(TShopEnum) to High(TShopEnum) do 187 | begin 188 | Shops.Shop[S].Clear; 189 | Max := EnsureRange(Player.Attributes.Attrib[atLev].Value * 4, 4, ItemMax); 190 | if S = shSmith then 191 | Max := EnsureRange(Max + 3, 7, ItemMax); 192 | for I := 0 to Max - 1 do 193 | begin 194 | repeat 195 | repeat 196 | until Check; 197 | until (TMapEnum(Player.MaxMap) in ItemBase[TItemEnum(ID)].Deep); 198 | Items.Make(Ord(ID), FItem); 199 | Items.Identify(FItem, True); 200 | Shops.Shop[S].Add(FItem); 201 | end; 202 | end; 203 | end; 204 | 205 | procedure TShops.Render; 206 | var 207 | I, C: Int; 208 | begin 209 | C := Shops.Shop[Shops.Current].Count.InRange(ItemMax); 210 | for I := 0 to C - 1 do 211 | Items.RenderInvItem(5, 2, I, Shops.Shop[Shops.Current].GetItem(I), True, 212 | True, ptBuy); 213 | end; 214 | 215 | procedure TShops.SetShop(I: TShopEnum; const Value: TShop); 216 | begin 217 | FShop[I] := Value; 218 | end; 219 | 220 | initialization 221 | 222 | Shops := TShops.Create; 223 | 224 | finalization 225 | 226 | FreeAndNil(Shops); 227 | 228 | end. 229 | -------------------------------------------------------------------------------- /sources/Trollhunter.Terminal.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Terminal; 2 | 3 | interface 4 | 5 | uses Types, Trollhunter.Types, BearLibTerminal; 6 | 7 | type 8 | TGlyph = record 9 | Symbol: string; 10 | ForegroundColor: Cardinal; 11 | BackgroundColor: Cardinal; 12 | end; 13 | 14 | type 15 | TSize = Types.TSize; 16 | 17 | type 18 | TEntSize = record 19 | Left: Int; 20 | Top: Int; 21 | Width: Int; 22 | Height: Int; 23 | end; 24 | 25 | var 26 | Screen, Panel, View, Status, Log, Info: TEntSize; 27 | 28 | type 29 | TTerminal = class(TObject) 30 | private 31 | FChar: TEntSize; 32 | FWindow: TEntSize; 33 | public 34 | constructor Create; 35 | destructor Destroy; override; 36 | procedure Init; 37 | procedure Clear; 38 | procedure Refresh; 39 | procedure BackgroundColor(Value: Cardinal); overload; 40 | procedure ForegroundColor(Value: Cardinal); overload; 41 | procedure Print(AX, AY: Int; AText: string); overload; 42 | procedure Print(AX, AY: Int; AText: string; Align: Int); overload; 43 | procedure Print(AX, AY: Int; AText: string; AForegroundColor: Cardinal; 44 | ABackgroundColor: Cardinal); overload; 45 | procedure Print(ALeft, ATop, AWidth, AHeight: Int; AText: string; 46 | Align: UInt); overload; 47 | function Pick(const AX, AY: UInt): UInt; 48 | property Char: TEntSize read FChar write FChar; 49 | property Window: TEntSize read FWindow write FWindow; 50 | function GetColorFromIni(AKey: string): string; overload; 51 | function GetColorFromIni(AKey: string; ADefault: string): Cardinal; 52 | overload; 53 | function Colorize(const AStr, AColor: string): string; overload; 54 | function Colorize(const ANum: Int; const AColor: string) 55 | : string; overload; 56 | function GetTextScreenshot: string; 57 | function SetEntSize(ALeft, ATop, AWidth, AHeight: UInt): TEntSize; 58 | function GetColor(Color: Int): Cardinal; 59 | end; 60 | 61 | var 62 | Terminal: TTerminal = nil; 63 | 64 | implementation 65 | 66 | uses SysUtils, Classes, Dialogs, Math, uGame; 67 | 68 | { TTerminal } 69 | 70 | procedure TTerminal.BackgroundColor(Value: Cardinal); 71 | begin 72 | terminal_bkcolor(Value); 73 | end; 74 | 75 | procedure TTerminal.Clear; 76 | begin 77 | terminal_clear(); 78 | end; 79 | 80 | function TTerminal.Colorize(const ANum: Int; const AColor: string): string; 81 | begin 82 | Result := Format('[color=%s]%d[/color]', [LowerCase(AColor), ANum]); 83 | end; 84 | 85 | function TTerminal.Colorize(const AStr, AColor: string): string; 86 | begin 87 | Result := Format('[color=%s]%s[/color]', [LowerCase(AColor), AStr]); 88 | end; 89 | 90 | constructor TTerminal.Create; 91 | begin 92 | terminal_open(); 93 | terminal_refresh(); 94 | Self.Init(); 95 | end; 96 | 97 | destructor TTerminal.Destroy; 98 | begin 99 | terminal_close(); 100 | inherited; 101 | end; 102 | 103 | procedure TTerminal.ForegroundColor(Value: Cardinal); 104 | begin 105 | terminal_color(Value); 106 | end; 107 | 108 | function TTerminal.GetColor(Color: Int): Cardinal; 109 | begin 110 | Result := color_from_argb($FF, UInt(Color), UInt(Color shr 8), 111 | UInt(Color shr 16)); 112 | end; 113 | 114 | function TTerminal.GetColorFromIni(AKey: string; ADefault: string): Cardinal; 115 | var 116 | S: string; 117 | begin 118 | S := GetColorFromIni(AKey); 119 | if (S = '') then 120 | S := ADefault; 121 | Result := color_from_name(S); 122 | end; 123 | 124 | function TTerminal.GetTextScreenshot: string; 125 | var 126 | SL: TStringList; 127 | X, Y, C: UInt; 128 | S: string; 129 | begin 130 | SL := TStringList.Create; 131 | try 132 | for Y := 0 to View.Height - 1 do 133 | begin 134 | S := ''; 135 | for X := 0 to View.Width - 1 do 136 | begin 137 | C := Terminal.Pick(X, Y); 138 | if (C >= 32) and (C < 126) then 139 | S := S + Chr(C) 140 | else 141 | S := S + ' '; 142 | end; 143 | SL.Append(S); 144 | end; 145 | Result := SL.Text; 146 | finally 147 | SL.Free; 148 | end; 149 | end; 150 | 151 | function TTerminal.GetColorFromIni(AKey: string): string; 152 | begin 153 | Result := LowerCase(terminal_get('ini.colors.' + LowerCase(AKey))); 154 | end; 155 | 156 | procedure TTerminal.Init; 157 | var 158 | Value: TEntSize; 159 | Wizard: string; 160 | begin 161 | Value.Width := EnsureRange(StrToIntDef(terminal_get('ini.screen.width'), 100), 162 | 100, UIntMax); 163 | Value.Height := EnsureRange(StrToIntDef(terminal_get('ini.screen.height'), 164 | 30), 30, UIntMax div 2); 165 | Screen := SetEntSize(0, 0, Value.Width, Value.Height); 166 | Value.Width := EnsureRange(StrToIntDef(terminal_get('ini.panel.width'), 167 | 35), 35, 50); 168 | Panel := SetEntSize(0, 0, Value.Width, 4); 169 | View := SetEntSize(1, 1, Screen.Width - Panel.Width - 3, Screen.Height - 2); 170 | Status := SetEntSize(View.Width + 2, 1, Panel.Width, Panel.Height); 171 | Log := SetEntSize(View.Width + 2, Status.Height + 4, Panel.Width, 172 | Screen.Height - Panel.Height - 9); 173 | Info := SetEntSize(View.Width + 2, Screen.Height - 4, Panel.Width, 3); 174 | // 175 | FWindow.Width := Screen.Width; 176 | FWindow.Height := Screen.Height; 177 | Wizard := ''; 178 | if Mode.Wizard then 179 | Wizard := '[WIZARD]'; 180 | terminal_set(Format('window: size=%dx%d, title=%s', 181 | [Screen.Width, Screen.Height, Format(Trim('%s %s'), [Game.GetTitle, 182 | Wizard])])); 183 | FChar.Width := terminal_state(TK_CELL_WIDTH); 184 | FChar.Height := terminal_state(TK_CELL_HEIGHT); 185 | terminal_set(Format('icon font: Fontello.ttf, size=%dx%d, codepage=437;', 186 | [Round(FChar.Width * 1.4), Round(FChar.Height * 1.4)])); 187 | end; 188 | 189 | procedure TTerminal.Print(AX, AY: Int; AText: string); 190 | begin 191 | terminal_print(AX, AY, TK_ALIGN_DEFAULT, AText); 192 | end; 193 | 194 | procedure TTerminal.Print(AX, AY: Int; AText: string; Align: Int); 195 | begin 196 | terminal_print(AX, AY, Align, AText); 197 | end; 198 | 199 | function TTerminal.Pick(const AX, AY: UInt): UInt; 200 | begin 201 | Result := terminal_pick(AX, AY, 0); 202 | end; 203 | 204 | procedure TTerminal.Print(ALeft, ATop, AWidth, AHeight: Int; AText: string; 205 | Align: UInt); 206 | begin 207 | terminal_print(ALeft, ATop, AWidth, AHeight, Align, AText); 208 | end; 209 | 210 | procedure TTerminal.Print(AX, AY: Int; AText: string; 211 | AForegroundColor: Cardinal; ABackgroundColor: Cardinal); 212 | begin 213 | terminal_bkcolor(ABackgroundColor); 214 | terminal_color(AForegroundColor); 215 | terminal_print(AX, AY, TK_ALIGN_DEFAULT, AText); 216 | end; 217 | 218 | procedure TTerminal.Refresh; 219 | begin 220 | terminal_refresh; 221 | end; 222 | 223 | function TTerminal.SetEntSize(ALeft, ATop, AWidth, AHeight: UInt): TEntSize; 224 | begin 225 | Result.Left := ALeft; 226 | Result.Top := ATop; 227 | Result.Width := AWidth; 228 | Result.Height := AHeight; 229 | end; 230 | 231 | initialization 232 | 233 | Terminal := TTerminal.Create; 234 | 235 | finalization 236 | 237 | FreeAndNil(Terminal); 238 | 239 | end. 240 | -------------------------------------------------------------------------------- /sources/BearLibItems/uBearLibItemsInventory.pas: -------------------------------------------------------------------------------- 1 | unit uBearLibItemsInventory; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, uBearLibItemsCommon; 6 | 7 | procedure Items_Inventory_Clear(); stdcall; 8 | 9 | function Items_Inventory_GetCount(): Int; stdcall; 10 | function Items_Inventory_GetItemCount(ItemID: Int): Int; stdcall; 11 | 12 | function Items_Inventory_GetWeight(): Int; stdcall; 13 | function Items_Inventory_GetItemWeight(ItemID: Int): Int; stdcall; 14 | 15 | function Items_Inventory_GetSize(): Int; stdcall; 16 | function Items_Inventory_GetItemSize(ItemID: Int): Int; stdcall; 17 | 18 | function Items_Inventory_GetItemAmount(ItemID: Int): Int; stdcall; 19 | function Items_Inventory_DeleteItemAmount(ItemID, Amount: Int): Int; stdcall; 20 | 21 | function Items_Inventory_SetItem(Index: Int; AItem: Item): Int; stdcall; 22 | function Items_Inventory_GetItem(Index: Int): Item; stdcall; 23 | 24 | procedure Items_Inventory_AppendItem(AItem: Item); stdcall; 25 | function Items_Inventory_DeleteItem(Index: Int; var AItem: Item): Int; stdcall; 26 | 27 | function Items_Inventory_EquipItem(Index: Int): Int; stdcall; 28 | function Items_Inventory_UnEquipItem(Index: Int): Int; stdcall; 29 | 30 | procedure Items_Inventory_SetSlotCount(ACount: Int); stdcall; 31 | function Items_Inventory_GetSlotCount: Int; stdcall; 32 | 33 | implementation 34 | 35 | var 36 | InvItems: TItems; 37 | SlotMax: Int = 26; 38 | 39 | procedure Items_Inventory_Clear(); stdcall; 40 | begin 41 | Empty(InvItems); 42 | end; 43 | 44 | function Items_Inventory_GetCount(): Int; stdcall; 45 | begin 46 | Result := Length(InvItems); 47 | end; 48 | 49 | function Items_Inventory_GetItemCount(ItemID: Int): Int; stdcall; 50 | var 51 | I: Int; 52 | begin 53 | Result := 0; 54 | for I := 0 to Length(InvItems) - 1 do 55 | if (InvItems[I].ItemID = ItemID) then 56 | Inc(Result); 57 | end; 58 | 59 | function Items_Inventory_GetWeight(): Int; stdcall; 60 | var 61 | I: Int; 62 | begin 63 | Result := 0; 64 | for I := 0 to Length(InvItems) - 1 do 65 | Inc(Result, InvItems[I].Weight); 66 | end; 67 | 68 | function Items_Inventory_GetItemWeight(ItemID: Int): Int; stdcall; 69 | var 70 | I: Int; 71 | begin 72 | Result := 0; 73 | for I := 0 to Length(InvItems) - 1 do 74 | if (InvItems[I].ItemID = ItemID) then 75 | Inc(Result, InvItems[I].Weight); 76 | end; 77 | 78 | function Items_Inventory_GetSize(): Int; stdcall; 79 | var 80 | I: Int; 81 | begin 82 | Result := 0; 83 | for I := 0 to Length(InvItems) - 1 do 84 | Inc(Result, InvItems[I].Size); 85 | end; 86 | 87 | function Items_Inventory_GetItemSize(ItemID: Int): Int; stdcall; 88 | var 89 | I: Int; 90 | begin 91 | Result := 0; 92 | for I := 0 to Length(InvItems) - 1 do 93 | if (InvItems[I].ItemID = ItemID) then 94 | Inc(Result, InvItems[I].Size); 95 | end; 96 | 97 | function Items_Inventory_GetItemAmount(ItemID: Int): Int; stdcall; 98 | var 99 | I: Int; 100 | begin 101 | Result := 0; 102 | for I := 0 to Length(InvItems) - 1 do 103 | if (InvItems[I].ItemID = ItemID) then 104 | Inc(Result, InvItems[I].Amount); 105 | end; 106 | 107 | function Items_Inventory_DeleteItemAmount(ItemID, Amount: Int): Int; stdcall; 108 | var 109 | I, C: Int; 110 | FItem: Item; 111 | begin 112 | Result := IntFalse; 113 | if (Amount <= 0) or (Items_Inventory_GetItemAmount(ItemID) < Amount) then Exit; 114 | C := Amount; 115 | for I := 0 to Length(InvItems) - 1 do 116 | if (InvItems[I].ItemID = ItemID) then 117 | begin 118 | Result := IntTrue; 119 | if (InvItems[I].Amount >= C) then 120 | begin 121 | InvItems[I].Amount := InvItems[I].Amount - C; 122 | if (InvItems[I].Amount <= 0) then 123 | begin 124 | Items_Inventory_DeleteItem(I, FItem); 125 | Exit; 126 | end; 127 | end else begin 128 | C := C - InvItems[I].Amount; 129 | Items_Inventory_DeleteItem(I, FItem); 130 | end; 131 | end; 132 | end; 133 | 134 | function Items_Inventory_GetItem(Index: Int): Item; stdcall; 135 | begin 136 | if IndexInRange(InvItems, Index) then 137 | Result := InvItems[Index]; 138 | end; 139 | 140 | function Items_Inventory_SetItem(Index: Int; AItem: Item): Int; stdcall; 141 | begin 142 | Result := IntFalse; 143 | if (AItem.Amount <= 0) then 144 | begin 145 | Result := Items_Inventory_DeleteItem(Index, AItem); 146 | Exit; 147 | end; 148 | if IndexInRange(InvItems, Index) then 149 | begin 150 | InvItems[Index] := AItem; 151 | Result := IntTrue; 152 | end; 153 | end; 154 | 155 | procedure Items_Inventory_AppendItem(AItem: Item); stdcall; 156 | var 157 | I, J, A: Int; 158 | begin 159 | if (AItem.Stack > 1) then 160 | begin 161 | if (Items_Inventory_GetItemCount(AItem.ItemID) > 0) then 162 | begin 163 | A := AItem.Amount; 164 | if not HasEmpty(InvItems) then 165 | for I := 0 to Length(InvItems) - 1 do 166 | if (InvItems[I].ItemID = AItem.ItemID) then 167 | begin 168 | if (InvItems[I].Amount < AItem.Stack) then 169 | begin 170 | J := AItem.Stack - InvItems[I].Amount; 171 | if (A - J < 0) then J := A; 172 | Dec(A, J); 173 | Inc(InvItems[I].Amount, J); 174 | end; 175 | end; 176 | while (A > 0) do 177 | begin 178 | J := AItem.Stack; 179 | if (A - J < 0) then J := A; 180 | Dec(A, J); 181 | AItem.Amount := J; 182 | AddItem(InvItems, AItem); 183 | end; 184 | end else AddItem(InvItems, AItem); 185 | end else AddItem(InvItems, AItem); 186 | end; 187 | 188 | function Items_Inventory_DeleteItem(Index: Int; var AItem: Item): Int; stdcall; 189 | begin 190 | Result := IntFalse; 191 | if IndexInRange(InvItems, Index) then 192 | begin 193 | AItem := DelItem(InvItems, Index); 194 | Result := IntTrue; 195 | end; 196 | end; 197 | 198 | function Items_Inventory_EquipItem(Index: Int): Int; stdcall; 199 | var 200 | I, FSlot: Int; 201 | begin 202 | Result := -1; 203 | if IndexInRange(InvItems, Index) then 204 | begin 205 | FSlot := InvItems[Index].SlotID; 206 | for I := 0 to Length(InvItems) - 1 do 207 | begin 208 | if (InvItems[I].SlotID = FSlot) 209 | and (InvItems[I].Equipment = IntTrue) then 210 | begin 211 | InvItems[I].Equipment := IntFalse; 212 | Result := I; 213 | Break; 214 | end; 215 | end; 216 | InvItems[Index].Equipment := IntTrue; 217 | end; 218 | end; 219 | 220 | function Items_Inventory_UnEquipItem(Index: Int): Int; stdcall; 221 | begin 222 | Result := IntFalse; 223 | if IndexInRange(InvItems, Index) then 224 | if (InvItems[Index].Equipment = IntTrue) then 225 | begin 226 | InvItems[Index].Equipment := IntFalse; 227 | Result := IntTrue; 228 | end; 229 | end; 230 | 231 | procedure Items_Inventory_SetSlotCount(ACount: Int); stdcall; 232 | begin 233 | SlotMax := ACount; 234 | if (SlotMax < 1) then SlotMax := 1; 235 | end; 236 | 237 | function Items_Inventory_GetSlotCount: Int; stdcall; 238 | begin 239 | Result := SlotMax; 240 | end; 241 | 242 | end. 243 | -------------------------------------------------------------------------------- /languages/default.lng: -------------------------------------------------------------------------------- 1 | "a credit to","a disgrace to","the black sheep of"= 2 | "an average","a sallow","a fair","a dark","a light"= 3 | "an only child","one of two children","one of many children","the only surviving child","one of several children","the illegitimate but acknowledged child","the illegitimate and unacknowledged child"= 4 | "auburn","blonde","black","dark","red","ginger","grey","brown"= 5 | "contented","peaceful","troubled","settled","disturbed"= 6 | "dull","unusually piercing","piercing","striking","dark"= 7 | "grey","violet","green","blue","brown","blue-gray"= 8 | "lower-class", "middle-class","upper-class"= 9 | "mercenary","merchant","businessman","titled noble","craftsman","soldier","templar","priest","guildsman","townsman"= 10 | "wavy","curly","straight","short","long"= 11 | %d gold left= 12 | %s blinded you (%d).= 13 | %s dies.= 14 | %s feel lust for blood (%d).= 15 | %s has burnt you (%d).= 16 | %s has cursed you (%d).= 17 | %s has infected you (%d).= 18 | %s hits you (%d).= 19 | %s is lying here.= 20 | %s is poisoning you (%d).= 21 | %s is stuns you (%d).= 22 | %s misses you.= 23 | %s notices you!= 24 | %s says: "%s"= 25 | %s scared you (%d).= 26 | %s: %s.= 27 | Accept= 28 | Affixes= 29 | Age= 30 | Apply= 31 | Athletics= 32 | Attributes= 33 | Auto pick up books= 34 | Auto pick up coins= 35 | Auto pick up flasks= 36 | Auto pick up food= 37 | Auto pick up gems= 38 | Auto pick up keys= 39 | Auto pick up magic items= 40 | Auto pick up plants= 41 | Auto pick up potions and flasks= 42 | Auto pick up runes= 43 | Auto pick up scrolls= 44 | Back= 45 | BeaRLibItems= 46 | BeaRLibTerminal= 47 | Better luck next time!= 48 | Bosses= 49 | Buy an item= 50 | Buy items (amulets and rings)= 51 | Buy items (armors)= 52 | Buy items (blacksmith)= 53 | Buy items (boots)= 54 | Buy items (foods)= 55 | Buy items (gems)= 56 | Buy items (gloves)= 57 | Buy items (healing)= 58 | Buy items (helms)= 59 | Buy items (items of mana)= 60 | Buy items (runes)= 61 | Buy items (scrolls)= 62 | Buy items (shields)= 63 | Buy items (tavern)= 64 | Buy items (weapons)= 65 | Buying at %s= 66 | Calendar= 67 | Change tab= 68 | Character Background= 69 | Character dump= 70 | Character Screen= 71 | Choose a class= 72 | Choose a difficulty= 73 | Choose a name= 74 | Choose a race= 75 | Choose a sex= 76 | Choose a talent= 77 | Choose the item you wish to drop= 78 | Class= 79 | Close= 80 | Coins Looted= 81 | Concentration= 82 | Confirm= 83 | confrontation. Good luck! You will need it.= 84 | Create a new hero= 85 | Creating the world, please wait...= 86 | Dark Wood= 87 | Decline= 88 | Defeated foes= 89 | Dexterity= 90 | Difficulty= 91 | Dirt= 92 | Do you wish to quit? %s/%s= 93 | Dodge= 94 | Door= 95 | Drop an item to the floor= 96 | Drop an item= 97 | Dwarf= 98 | Easy= 99 | Effects= 100 | Elf= 101 | Elvion. Survive, gather equipment, fight adversaries and be ready for the final= 102 | Enchant an item= 103 | Engorged= 104 | Enter amount= 105 | Enter your player's name= 106 | Far away in an uncharted region of the Earth land Elvion lies surrounded by mountains.= 107 | Female= 108 | Foods Eaten= 109 | Full= 110 | Fullscreen= 111 | Game Difficulty= 112 | Game over!!!= 113 | Game time: %d turns.= 114 | Game Version= 115 | Gate= 116 | Gnome= 117 | Go down stairs= 118 | Go up stairs= 119 | Gold= 120 | Good day!= 121 | Grass= 122 | grave danger as the Troll King and his armies are marching to lay waste on all of= 123 | Gray Cave= 124 | Hard= 125 | He has scored %d points so far.= 126 | He scored %d points.= 127 | Height= 128 | Hell= 129 | Help= 130 | Hide level of an item= 131 | Humans are the most common of races.= 132 | Hungry= 133 | Identification= 134 | In the center of this land there is a village named Dork. It's people are in= 135 | Inventory= 136 | It was a good hit!= 137 | It was an excellent hit!= 138 | Item Types= 139 | Items Crafted= 140 | Items Found= 141 | Items Identified= 142 | Items Repaired= 143 | Items Used= 144 | Items= 145 | its inhabitants. Unless a hero will rise to take a stand against the forces of evil.= 146 | Keybindings= 147 | Killed by %s= 148 | Last messages= 149 | Leave corpses= 150 | Less= 151 | Level= 152 | Life= 153 | Look mode= 154 | Mage= 155 | Male= 156 | Mana= 157 | Max= 158 | Metabolism= 159 | Monsters Killed= 160 | Monsters= 161 | More= 162 | Move= 163 | Name= 164 | Near starving= 165 | Normal= 166 | NPCs= 167 | Options= 168 | Perception= 169 | Pick up all items= 170 | Pick up an item from the floor= 171 | Pick up an item= 172 | Portal= 173 | Potions Drunk= 174 | Press %s to exit...= 175 | Press %s to try again...= 176 | Press ? for help.= 177 | Quests= 178 | Quit the game= 179 | Race= 180 | Random= 181 | Ranger= 182 | Receive healing= 183 | Reload all shops= 184 | Repair items= 185 | Repairing an item= 186 | Repairing items= 187 | Re-roll= 188 | Rest duration= 189 | Rest for 10 turns= 190 | Rest for 100 turns= 191 | Rest for 1000 turns= 192 | Rest= 193 | Rock= 194 | Satiated= 195 | Scores= 196 | Screenshot= 197 | Scroll skills= 198 | Scrolls Read= 199 | Select a class= 200 | Select a race= 201 | Select a talent= 202 | Select an item= 203 | Sell items= 204 | Selling an item= 205 | Selling items= 206 | Settings= 207 | Several items (%dx) are lying here (%s).= 208 | Sex= 209 | Shops= 210 | Show Background= 211 | Show ID of items= 212 | Show Inventory= 213 | Show items price in inventory= 214 | Show map= 215 | Show Statistics= 216 | Show this Help Screen= 217 | Skills (%d-%d)= 218 | Skills= 219 | Spells Cast= 220 | Stairs= 221 | Start game= 222 | Starving= 223 | Statistics= 224 | Stone Floor= 225 | Stone Wall= 226 | Stone= 227 | Strength= 228 | Talents= 229 | The game saves a character dump to %s file.= 230 | The Hunt (quest)= 231 | The new quest is added to the log.= 232 | Thief= 233 | Tiles Moved= 234 | To drop an item, press the %s key and then press %s key to drop it.= 235 | Toughness= 236 | Tree= 237 | Trollhunter= 238 | Turn Wizard Mode Off= 239 | Unidentified= 240 | Use a race= 241 | Use an item= 242 | Version= 243 | Very full= 244 | Very hungry= 245 | View messages= 246 | Village Dork= 247 | Wait= 248 | Wall= 249 | Warrior= 250 | Water= 251 | Weight= 252 | Welcome to Elvion!= 253 | What can I do for you?= 254 | What can I get you today?= 255 | Willpower= 256 | Wizard Mode= 257 | Wooden Floor= 258 | Wooden Wall= 259 | You advance to level %d!= 260 | You are %s of a %s %s. You had a %s upbringing and you are %s the family. You have %s %s eyes, %s %s hair, and %s complexion.= 261 | You are drunk (%d).= 262 | You are the hero who departs on a quest to stop the enemies and save your homeland,= 263 | You ate %s.= 264 | You bought %s (-%d gold).= 265 | You can not use this yet (unidentified)!= 266 | You cannot climb up here.= 267 | You climb down the ladder...= 268 | You climb up the ladder...= 269 | You crafted %s.= 270 | You die...= 271 | You drop %s.= 272 | You equip %s.= 273 | You feel a wee bit better.= 274 | You feel better (-%d gold).= 275 | You feel healthy.= 276 | You gained 1 talent point.= 277 | You have opened a new territory: %s.= 278 | You have sated %d hunger.= 279 | You hit %s (%d).= 280 | You identified %s.= 281 | You kill %s.= 282 | You miss %s.= 283 | You need more mana!= 284 | You need to find and kill The King Troll!= 285 | You picked up %s (%dx).= 286 | You picked up %s.= 287 | You read %s.= 288 | You repaired %s (-%d gold).= 289 | You sold %s (+%d gold).= 290 | You unequip %s.= 291 | You use %s.= 292 | You were slain by %s. Press %s= 293 | Your skill %s has raised to %d!= 294 |  295 | -------------------------------------------------------------------------------- /sources/uGame.pas: -------------------------------------------------------------------------------- 1 | unit uGame; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, 6 | uEntity, 7 | uMap, 8 | uLanguage; 9 | 10 | { 11 | "Berserk" : "While berserk, combatant will get an extra attack (or spell cast) each turn." 12 | "Blessed" : "A blessed combatant suffers less damage from physical and magical attacks." 13 | "Blinded" : "When blinded, combatant's chance to hit when attack will be reduced considerably." 14 | "Eagle-eyed" : "An eagle-eyed combatant is more likely to hit with physical attacks." 15 | "Paralyzed" : "When paralyzed, a combatant cannot do anything and its turn is skipped." 16 | "Poisoned" : "A poisoned combatant suffers poison damage each turn, although it will not die from it." 17 | "Protected" : "A protected combatant is harder to hit with physical attacks." 18 | "Quick" : "A quick combatant can take additional steps when moving each turn." 19 | "Resistant" : "A resistant combatant is less affected by magical attacks." 20 | "Rooted" : "A rooted combatant cannot move, although it may still attack and cast spells." 21 | "Sluggish" : "A sluggish combatant is easier to hit with phsyical attacks." 22 | "Strong" : "A strong combatant inflicts more damage with physical attacks." 23 | "Weakened" : "A weakened combatant inflicts less damage with physical attacks." 24 | } 25 | 26 | { 27 | var 28 | BattleJournals: array of string; 29 | 30 | procedure BattleLog(s: string); 31 | begin 32 | SetLength(BattleJournals, Length(BattleJournals) + 1); 33 | BattleJournals[Length(BattleJournals) - 1] := s; 34 | end; 35 | 36 | function BattleJournal: string; 37 | var 38 | s: string; 39 | i: integer; 40 | begin 41 | s := ''; 42 | for i := max(0, Length(BattleJournals) - N_BTL_LOG_LINES) 43 | to Length(BattleJournals) - 1 do 44 | s := s + BattleJournals[i] + #10; 45 | SetLength(s, Length(s) - 1); 46 | Result := s; 47 | end; 48 | } 49 | 50 | const 51 | FT = '== %s =='; 52 | 53 | const 54 | clBlack = $00000000; 55 | clWhite = $FFDDDDDD; 56 | 57 | clGray = $FF777777; 58 | clRed = $FFFF0000; 59 | clGreen = $FF00FF00; 60 | clBlue = $FF0000FF; 61 | clYellow = $FFFFFF00; 62 | 63 | clLightGray = $FF999999; 64 | clLightRed = $FFFF8888; 65 | clLightGreen = $FF88FF88; 66 | clLightBlue = $FF8888FF; 67 | clLightYellow = $FFFFFF88; 68 | 69 | clLighterGray = $FFAAAAAA; 70 | clLighterRed = $FFFFAAAA; 71 | clLighterGreen = $FFAAFFAA; 72 | clLighterBlue = $FFAAAAFF; 73 | clLighterYellow = $FFFFFFAA; 74 | 75 | clLightestGray = $FFBBBBBB; 76 | clLightestRed = $FFFFCCCC; 77 | clLightestGreen = $FFCCFFCC; 78 | clLightestBlue = $FFCCCCFF; 79 | clLightestYellow = $FFFFFFCC; 80 | 81 | clDarkGray = $FF222222; 82 | clDarkRed = $FF880000; 83 | clDarkGreen = $FF008800; 84 | clDarkBlue = $FF000088; 85 | clDarkYellow = $FF888800; 86 | 87 | clDarkestRed = $FF330000; 88 | 89 | const 90 | clFog = $FF222222; 91 | 92 | var 93 | clDefault: Cardinal = $FFFFFF00; 94 | clBackground: Cardinal = $00000000; 95 | clCorpse: Cardinal = $FF555555; 96 | clLook: Cardinal = $FFFFFF33; 97 | clBkMob: Cardinal = $FF330000; 98 | clPlayer: Cardinal = $FF009900; 99 | clBkPlayer: Cardinal = $FF003300; 100 | clLife: Cardinal = $FF990000; 101 | clMana: Cardinal = $FF000099; 102 | 103 | var 104 | clAlarm: string = 'Lightest Green'; 105 | 106 | type 107 | TMode = record 108 | Game: Boolean; 109 | Wizard: Boolean; 110 | end; 111 | 112 | var 113 | Mode: TMode; 114 | 115 | type 116 | TSpawn = class(TEntity); 117 | 118 | type 119 | TAPOptionEnum = (apCoin, apFood, apRune, apGem, apBook, apPotion, apFlask, 120 | apScroll, apKey, apPlant, apFullscreen, apHdLevOfItem, apShPrice, apMagic); 121 | 122 | type 123 | TGame = class(TObject) 124 | private 125 | FTimer: UInt; 126 | FWon: Boolean; 127 | FCanClose: Boolean; 128 | FShowMap: Boolean; 129 | FShowID: Boolean; 130 | FLCorpses: Boolean; 131 | FScreenshot: string; 132 | FSpawn: TSpawn; 133 | FPortal: TSpawn; 134 | FPortalMap: TMapEnum; 135 | FPortalTile: TTileEnum; 136 | FShowEffects: Boolean; 137 | FAPOption: array [TAPOptionEnum] of Boolean; 138 | public 139 | constructor Create; 140 | destructor Destroy; override; 141 | property Timer: UInt read FTimer write FTimer; 142 | property Won: Boolean read FWon write FWon; 143 | property CanClose: Boolean read FCanClose write FCanClose; 144 | property ShowMap: Boolean read FShowMap write FShowMap; 145 | property ShowID: Boolean read FShowID write FShowID; 146 | property LCorpses: Boolean read FLCorpses write FLCorpses; 147 | property Screenshot: string read FScreenshot write FScreenshot; 148 | property Spawn: TSpawn read FSpawn write FSpawn; 149 | property Portal: TSpawn read FPortal write FPortal; 150 | function GetVersion: string; 151 | property PortalMap: TMapEnum read FPortalMap write FPortalMap; 152 | property PortalTile: TTileEnum read FPortalTile write FPortalTile; 153 | property ShowEffects: Boolean read FShowEffects write FShowEffects; 154 | function GetTitle: string; 155 | procedure LoadConfig; 156 | procedure Start; 157 | procedure Log(S: string); 158 | function GetCursor: string; 159 | function IfThen(AValue: Boolean; const ATrue: string; 160 | const AFalse: string): string; 161 | function EnsureRange(const AValue, AMax: Int): Int; 162 | function GetOption(I: TAPOptionEnum): Boolean; 163 | procedure ChOption(I: TAPOptionEnum); 164 | procedure ChScreen; 165 | end; 166 | 167 | var 168 | Game: TGame; 169 | 170 | implementation 171 | 172 | uses SysUtils, 173 | Trollhunter.Player, 174 | Trollhunter.UI.Log, 175 | uScenes, 176 | Math, 177 | Dialogs, 178 | BearLibTerminal, 179 | uItem, 180 | uMob, 181 | Trollhunter.Terminal, 182 | Trollhunter.Item.Shop, 183 | uSpellbook, 184 | uHelpers; 185 | 186 | { TGame } 187 | 188 | procedure TGame.ChScreen; 189 | begin 190 | if FAPOption[apFullscreen] then 191 | terminal_set('window.fullscreen=true') 192 | else 193 | terminal_set('window.fullscreen=false'); 194 | end; 195 | 196 | constructor TGame.Create; 197 | var 198 | I: UInt; 199 | J: TAPOptionEnum; 200 | IsUseLang: Boolean; 201 | begin 202 | Randomize; 203 | Timer := 0; 204 | Won := False; 205 | Mode.Game := False; 206 | Mode.Wizard := False; 207 | IsUseLang := False; 208 | for J := Low(TAPOptionEnum) to High(TAPOptionEnum) do 209 | FAPOption[J] := True; 210 | CanClose := False; 211 | ShowEffects := False; 212 | ShowMap := True; 213 | ShowID := False; 214 | LCorpses := True; 215 | FSpawn := TSpawn.Create; 216 | FPortal := TSpawn.Create; 217 | PortalMap := deDark_Wood; 218 | PortalTile := teStoneFloor; 219 | for I := 1 to ParamCount do 220 | begin 221 | if (LowerCase(ParamStr(I)) = '-w') then 222 | Mode.Wizard := True; 223 | if (LowerCase(ParamStr(I)) = '-l') then 224 | IsUseLang := True; 225 | end; 226 | Language := TLanguage.Create(IsUseLang); 227 | Language.UseLanguage('russian'); 228 | end; 229 | 230 | destructor TGame.Destroy; 231 | begin 232 | Language.SaveDefault; 233 | FreeAndNil(Language); 234 | FreeAndNil(FPortal); 235 | FreeAndNil(FSpawn); 236 | inherited; 237 | end; 238 | 239 | function TGame.EnsureRange(const AValue, AMax: Int): Int; 240 | begin 241 | Result := AValue.InRange(AMax); 242 | end; 243 | 244 | function TGame.IfThen(AValue: Boolean; const ATrue: string; 245 | const AFalse: string): string; 246 | begin 247 | if AValue then 248 | Result := ATrue 249 | else 250 | Result := AFalse; 251 | end; 252 | 253 | function TGame.GetCursor: string; 254 | begin 255 | Result := '_'; 256 | end; 257 | 258 | function TGame.GetOption(I: TAPOptionEnum): Boolean; 259 | begin 260 | Result := FAPOption[I] 261 | end; 262 | 263 | function TGame.GetVersion: string; 264 | begin 265 | Result := '0.14.0'; 266 | end; 267 | 268 | procedure TGame.Log(S: string); 269 | begin 270 | terminal_set('Log: ' + S); 271 | end; 272 | 273 | procedure TGame.LoadConfig; 274 | begin 275 | // Settings 276 | FAPOption[apFullscreen] := terminal_get('window.fullscreen') = 'true'; 277 | // Localization 278 | Language.UseLanguage(terminal_get('ini.localization.language')); 279 | // Load colors 280 | clDefault := Terminal.GetColorFromIni('Default', 'Yellow'); 281 | clBackground := Terminal.GetColorFromIni('Background', 'Black'); 282 | clCorpse := Terminal.GetColorFromIni('Corpse', 'Gray'); 283 | clLook := Terminal.GetColorFromIni('Look', 'Yellow'); 284 | clBkMob := Terminal.GetColorFromIni('BkMob', 'Darkest Red'); 285 | clPlayer := Terminal.GetColorFromIni('Player', 'Yellow'); 286 | clBkPlayer := Terminal.GetColorFromIni('BkPlayer', 'Darkest Green'); 287 | clAlarm := Terminal.GetColorFromIni('Alarm'); 288 | clLife := Terminal.GetColorFromIni('LifeBar', 'Life'); 289 | clMana := Terminal.GetColorFromIni('ManaBar', 'Mana'); 290 | end; 291 | 292 | procedure TGame.ChOption(I: TAPOptionEnum); 293 | begin 294 | FAPOption[I] := not FAPOption[I]; 295 | end; 296 | 297 | procedure TGame.Start; 298 | begin 299 | Player.Clear; 300 | Player.Start; 301 | Player.Calc; 302 | Player.Fill; 303 | Spellbook.Start; 304 | Shops.New; 305 | // Intro 306 | MsgLog.Clear; 307 | MsgLog.Add(Terminal.Colorize(Format('%s %s %s', [_('Welcome to Elvion!'), 308 | _('You need to find and kill The King Troll!'), _('Press ? for help.')]), 309 | clAlarm)); 310 | end; 311 | 312 | function TGame.GetTitle: string; 313 | begin 314 | Result := _('Trollhunter'); 315 | end; 316 | 317 | initialization 318 | 319 | Game := TGame.Create; 320 | 321 | finalization 322 | 323 | FreeAndNil(Game); 324 | 325 | end. 326 | -------------------------------------------------------------------------------- /sources/BearLibItems/uBearLibItemsDungeon.pas: -------------------------------------------------------------------------------- 1 | unit uBearLibItemsDungeon; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, uBearLibItemsCommon; 6 | 7 | procedure Items_Dungeon_Clear(); stdcall; 8 | procedure Items_Dungeon_MapClear(MapID: Int); stdcall; 9 | procedure Items_Dungeon_MapClearXY(MapID: Int; AX, AY: Int); stdcall; 10 | 11 | function Items_Dungeon_GetCount(): Int; stdcall; 12 | function Items_Dungeon_GetMapCount(MapID: Int): Int; stdcall; 13 | function Items_Dungeon_GetMapCountXY(MapID: Int; AX, AY: Int): Int; stdcall; 14 | 15 | function Items_Dungeon_GetItemCount(ItemID: Int): Int; stdcall; 16 | function Items_Dungeon_GetMapItemCount(MapID, ItemID: Int): Int; stdcall; 17 | function Items_Dungeon_GetMapItemCountXY(MapID, ItemID: Int; AX, AY: Int): Int; stdcall; 18 | 19 | function Items_Dungeon_SetItem(Index: Int; AItem: Item): Int; stdcall; 20 | function Items_Dungeon_GetItem(Index: Int): Item; stdcall; 21 | 22 | function Items_Dungeon_SetMapItem(MapID, Index: Int; AItem: Item): Int; stdcall; 23 | function Items_Dungeon_GetMapItem(MapID, Index: Int): Item; stdcall; 24 | 25 | function Items_Dungeon_SetMapItemXY(MapID, Index: Int; AX, AY: Int; AItem: Item): Int; stdcall; 26 | function Items_Dungeon_GetMapItemXY(MapID, Index: Int; AX, AY: Int): Item; stdcall; 27 | 28 | procedure Items_Dungeon_AppendItem(AItem: Item); stdcall; 29 | 30 | function Items_Dungeon_DeleteItem(Index: Int; var AItem: Item): Int; stdcall; 31 | function Items_Dungeon_DeleteMapItem(MapID: Int; Index: Int; var AItem: Item): Int; stdcall; 32 | function Items_Dungeon_DeleteMapItemXY(MapID: Int; Index, AX, AY: Int; var AItem: Item): Int; stdcall; 33 | 34 | function Items_Dungeon_GetMapItemAmountXY(MapID, ItemID, AX, AY: Int): Int; stdcall; 35 | 36 | implementation 37 | 38 | var 39 | MapItems: TItems; 40 | 41 | procedure Items_Dungeon_Clear(); stdcall; 42 | begin 43 | Empty(MapItems); 44 | end; 45 | 46 | procedure Items_Dungeon_MapClear(MapID: Int); stdcall; 47 | var 48 | I: Int; 49 | begin 50 | for I := 0 to Length(MapItems) - 1 do 51 | if HasItem(MapItems, I, MapID) then 52 | DelItem(MapItems, I); 53 | end; 54 | 55 | procedure Items_Dungeon_MapClearXY(MapID: Int; AX, AY: Int); stdcall; 56 | var 57 | I: Int; 58 | begin 59 | if HasEmpty(MapItems) then 60 | Exit; 61 | for I := 0 to Length(MapItems) - 1 do 62 | if HasItem(MapItems, I, MapID, AX, AY) then 63 | DelItem(MapItems, I); 64 | end; 65 | 66 | function Items_Dungeon_GetCount(): Int; stdcall; 67 | begin 68 | Result := Length(MapItems); 69 | end; 70 | 71 | function Items_Dungeon_GetMapCount(MapID: Int): Int; stdcall; 72 | var 73 | I: Int; 74 | begin 75 | Result := 0; 76 | for I := 0 to Length(MapItems) - 1 do 77 | if HasItem(MapItems, I, MapID) then 78 | Inc(Result); 79 | end; 80 | 81 | function Items_Dungeon_GetMapCountXY(MapID: Int; AX, AY: Int): Int; stdcall; 82 | var 83 | I: Int; 84 | begin 85 | Result := 0; 86 | if HasEmpty(MapItems) then 87 | Exit; 88 | for I := 0 to Length(MapItems) - 1 do 89 | if HasItem(MapItems, I, MapID, AX, AY) then 90 | Inc(Result); 91 | end; 92 | 93 | function Items_Dungeon_GetItemCount(ItemID: Int): Int; stdcall; 94 | var 95 | I: Int; 96 | begin 97 | Result := 0; 98 | for I := 0 to Length(MapItems) - 1 do 99 | if (MapItems[I].ItemID = ItemID) then 100 | Inc(Result); 101 | end; 102 | 103 | function Items_Dungeon_GetMapItemCount(MapID, ItemID: Int): Int; stdcall; 104 | var 105 | I: Int; 106 | begin 107 | Result := 0; 108 | for I := 0 to Length(MapItems) - 1 do 109 | if (MapItems[I].MapID = MapID) and (MapItems[I].ItemID = ItemID) then 110 | Inc(Result); 111 | end; 112 | 113 | function Items_Dungeon_GetMapItemCountXY(MapID, ItemID: Int; AX, AY: Int): Int; stdcall; 114 | var 115 | I: Int; 116 | begin 117 | Result := 0; 118 | if HasEmpty(MapItems) then 119 | Exit; 120 | for I := 0 to Length(MapItems) - 1 do 121 | if HasItem(MapItems, I, MapID, AX, AY) and (MapItems[I].ItemID = ItemID) then 122 | Inc(Result); 123 | end; 124 | 125 | function Items_Dungeon_SetItem(Index: Int; AItem: Item): Int; stdcall; 126 | begin 127 | Result := IntFalse; 128 | if IndexInRange(MapItems, Index) then 129 | begin 130 | MapItems[Index] := AItem; 131 | Result := IntTrue; 132 | end; 133 | end; 134 | 135 | function Items_Dungeon_GetItem(Index: Int): Item; stdcall; 136 | begin 137 | Result := MapItems[Index]; 138 | end; 139 | 140 | function Items_Dungeon_SetMapItem(MapID, Index: Int; AItem: Item): Int; stdcall; 141 | var 142 | I: Int; 143 | begin 144 | Result := IntFalse; 145 | if HasEmpty(MapItems) then 146 | Exit; 147 | if not IndexInRange(MapItems, Index) then 148 | Exit; 149 | I := GlobalIndex(MapItems, MapID, Index); 150 | if (I < 0) then 151 | Exit; 152 | if (AItem.Amount <= 0) and (Items_Dungeon_DeleteItem(Index, AItem) = IntTrue) then 153 | Exit; 154 | Result := Items_Dungeon_SetItem(I, AItem); 155 | end; 156 | 157 | function Items_Dungeon_GetMapItem(MapID, Index: Int): Item; stdcall; 158 | var 159 | I: Int; 160 | begin 161 | Items_Clear_Item(Result); 162 | if HasEmpty(MapItems) then 163 | Exit; 164 | if not IndexInRange(MapItems, Index) then 165 | Exit; 166 | I := GlobalIndex(MapItems, MapID, Index); 167 | if (I < 0) then 168 | Exit; 169 | Result := Items_Dungeon_GetItem(I); 170 | if (Result.Amount < 0) then 171 | Exit; 172 | end; 173 | 174 | function Items_Dungeon_SetMapItemXY(MapID, Index: Int; AX, AY: Int; AItem: Item): Int; stdcall; 175 | var 176 | I: Int; 177 | begin 178 | Result := IntFalse; 179 | if HasEmpty(MapItems) then 180 | Exit; 181 | if not IndexInRange(MapItems, Index) then 182 | Exit; 183 | I := GlobalIndex(MapItems, MapID, Index, AX, AY); 184 | if (I < 0) then 185 | Exit; 186 | if (AItem.Amount <= 0) and (Items_Dungeon_DeleteMapItemXY(MapID, Index, AX, AY, AItem) = IntTrue) then 187 | Exit; 188 | Result := Items_Dungeon_SetItem(I, AItem); 189 | end; 190 | 191 | function Items_Dungeon_GetMapItemXY(MapID, Index: Int; AX, AY: Int): Item; stdcall; 192 | var 193 | I: Int; 194 | begin 195 | Items_Clear_Item(Result); 196 | if HasEmpty(MapItems) then 197 | Exit; 198 | if not IndexInRange(MapItems, Index) then 199 | Exit; 200 | I := GlobalIndex(MapItems, MapID, Index, AX, AY); 201 | if (I < 0) then 202 | Exit; 203 | Result := Items_Dungeon_GetItem(I); 204 | if (Result.Amount < 0) then 205 | Exit; 206 | end; 207 | 208 | procedure Items_Dungeon_AppendItem(AItem: Item); stdcall; 209 | var 210 | I, J, A: Int; 211 | 212 | procedure Add(AItem: Item); stdcall; 213 | var 214 | A, J: Int; 215 | begin 216 | A := AItem.Amount; 217 | while (A > 0) do 218 | begin 219 | J := AItem.Stack; 220 | if (A - J < 0) then 221 | J := A; 222 | Dec(A, J); 223 | AItem.Amount := J; 224 | AddItem(MapItems, AItem); 225 | end; 226 | end; 227 | 228 | begin 229 | if (AItem.Stack > 1) then 230 | begin 231 | if (Items_Dungeon_GetMapItemCountXY(AItem.MapID, AItem.ItemID, AItem.X, AItem.Y) > 0) then 232 | begin 233 | A := AItem.Amount; 234 | if not HasEmpty(MapItems) then 235 | for I := 0 to Length(MapItems) - 1 do 236 | if HasItem(MapItems, I, AItem.MapID, AItem.X, AItem.Y) and (MapItems[I].ItemID = AItem.ItemID) then 237 | begin 238 | if (MapItems[I].Amount < AItem.Stack) then 239 | begin 240 | J := AItem.Stack - MapItems[I].Amount; 241 | if (A - J < 0) then 242 | J := A; 243 | Dec(A, J); 244 | Inc(MapItems[I].Amount, J); 245 | end; 246 | end; 247 | while (A > 0) do 248 | begin 249 | J := AItem.Stack; 250 | if (A - J < 0) then 251 | J := A; 252 | Dec(A, J); 253 | AItem.Amount := J; 254 | AddItem(MapItems, AItem); 255 | end; 256 | end 257 | else 258 | Add(AItem); 259 | end 260 | else 261 | Add(AItem); 262 | end; 263 | 264 | function Items_Dungeon_DeleteItem(Index: Int; var AItem: Item): Int; stdcall; 265 | begin 266 | Result := IntFalse; 267 | if IndexInRange(MapItems, Index) then 268 | begin 269 | AItem := DelItem(MapItems, Index); 270 | Result := IntTrue; 271 | end; 272 | end; 273 | 274 | function Items_Dungeon_DeleteMapItem(MapID: Int; Index: Int; var AItem: Item): Int; stdcall; 275 | var 276 | I: Int; 277 | P: Int; 278 | begin 279 | Result := IntFalse; 280 | if not IndexInRange(MapItems, Index) then 281 | Exit; 282 | P := 0; 283 | for I := 0 to Length(MapItems) - 1 do 284 | if HasItem(MapItems, I, MapID) then 285 | begin 286 | if (P = Index) then 287 | begin 288 | AItem := DelItem(MapItems, I); 289 | Result := IntTrue; 290 | Exit; 291 | end; 292 | Inc(P); 293 | end; 294 | end; 295 | 296 | function Items_Dungeon_DeleteMapItemXY(MapID: Int; Index, AX, AY: Int; var AItem: Item): Int; stdcall; 297 | var 298 | I: Int; 299 | P: Int; 300 | begin 301 | Result := IntFalse; 302 | if not IndexInRange(MapItems, Index) then 303 | Exit; 304 | P := 0; 305 | for I := 0 to Length(MapItems) - 1 do 306 | if HasItem(MapItems, I, MapID, AX, AY) then 307 | begin 308 | if (P = Index) then 309 | begin 310 | AItem := DelItem(MapItems, I); 311 | Result := IntTrue; 312 | Exit; 313 | end; 314 | Inc(P); 315 | end; 316 | end; 317 | 318 | function Items_Dungeon_GetMapItemAmountXY(MapID, ItemID, AX, AY: Int): Int; stdcall; 319 | var 320 | I: Int; 321 | begin 322 | Result := 0; 323 | if HasEmpty(MapItems) then 324 | Exit; 325 | for I := 0 to Length(MapItems) - 1 do 326 | if HasItem(MapItems, I, MapID, AX, AY) and (MapItems[I].ItemID = ItemID) then 327 | Inc(Result, MapItems[I].Amount); 328 | end; 329 | 330 | end. 331 | -------------------------------------------------------------------------------- /sources/Trollhunter.Scene.RacesAndClasses.pas: -------------------------------------------------------------------------------- 1 | unit Trollhunter.Scene.RacesAndClasses; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types, 6 | uScenes; 7 | 8 | type 9 | TVScene = class(TScene) 10 | private 11 | DX: UInt; 12 | public 13 | procedure Render; override; 14 | end; 15 | 16 | type 17 | TSceneRace = class(TVScene) 18 | public 19 | procedure ReRoll; 20 | procedure SelRand; 21 | procedure Render; override; 22 | procedure Update(var Key: UInt); override; 23 | class procedure RenderInfo; 24 | end; 25 | 26 | type 27 | TSceneClass = class(TVScene) 28 | public 29 | procedure ReRoll; 30 | procedure SelRand; 31 | procedure Render; override; 32 | procedure Update(var Key: UInt); override; 33 | end; 34 | 35 | implementation 36 | 37 | uses Math, 38 | BearLibTerminal, 39 | uLanguage, 40 | Trollhunter.Terminal, 41 | Trollhunter.Player, 42 | uAttribute, 43 | uAbility, 44 | uGame, 45 | Trollhunter.Player.Races, 46 | Trollhunter.Player.Classes, 47 | Trollhunter.UI, 48 | Trollhunter.Statistic, 49 | uSkill, 50 | Trollhunter.Player.Types, 51 | Trollhunter.Player.Helpers; 52 | 53 | var 54 | PrmAt: array [atStr .. atMana] of UInt; 55 | 56 | { TVScene } 57 | 58 | procedure TVScene.Render; 59 | begin 60 | DX := CX - (CX div 2); 61 | Terminal.ForegroundColor(clWhite); 62 | Terminal.Print(DX, 3, _('Age') + ': ' + Terminal.Colorize 63 | (Player.Statictics.Get(stAge), 'Lush')); 64 | Terminal.Print(DX, 4, _('Height') + ': ' + Terminal.Colorize 65 | (Player.Statictics.Get(stHeight), 'Lush')); 66 | Terminal.Print(DX, 5, _('Weight') + ': ' + Terminal.Colorize 67 | (Player.Statictics.Get(stWeight), 'Lush')); 68 | Terminal.Print(DX, 6, _('Sex') + ': ' + Terminal.Colorize 69 | (Player.Gender, 'Lush')); 70 | Terminal.Print(DX, 7, _('Metabolism') + ': ' + 71 | Terminal.Colorize(Player.Statictics.Get(stMetabolism), 'Lush')); 72 | 73 | // Attributes 74 | Terminal.Print(DX, 9, _('Strength') + ': ' + 75 | Terminal.Colorize(Player.Attributes.Attrib[atStr].Prm, 'Lush')); 76 | Terminal.Print(DX, 10, _('Dexterity') + ': ' + 77 | Terminal.Colorize(Player.Attributes.Attrib[atDex].Prm, 'Lush')); 78 | Terminal.Print(DX, 11, _('Willpower') + ': ' + 79 | Terminal.Colorize(Player.Attributes.Attrib[atWil].Prm, 'Lush')); 80 | Terminal.Print(DX, 12, _('Perception') + ': ' + 81 | Terminal.Colorize(Player.Attributes.Attrib[atPer].Prm, 'Lush')); 82 | 83 | // Life and Mana 84 | Terminal.Print(DX, 14, _('Life') + ': ' + Terminal.Colorize 85 | (Player.Attributes.Attrib[atLife].Prm, 'Lush')); 86 | Terminal.Print(DX, 15, _('Mana') + ': ' + Terminal.Colorize 87 | (Player.Attributes.Attrib[atMana].Prm, 'Lush')); 88 | end; 89 | 90 | { TSceneRace } 91 | 92 | procedure TSceneRace.Render; 93 | var 94 | I: UInt; 95 | R: TRaceEnum; 96 | 97 | procedure Add(const AName: string); 98 | var 99 | C: Char; 100 | begin 101 | C := Chr(I + Ord('A')); 102 | Terminal.ForegroundColor(clWhite); 103 | Terminal.Print(1, Y, UI.KeyToStr(C)); 104 | if (R = Player.HRace) then 105 | Terminal.ForegroundColor(clYellow) 106 | else 107 | Terminal.ForegroundColor(clWhite); 108 | Terminal.Print(5, Y, AName); 109 | Inc(I); 110 | Inc(Y); 111 | end; 112 | 113 | begin 114 | UI.Title(_('Choose a race')); 115 | I := 0; 116 | Y := 2; 117 | for R := Low(TRaceEnum) to High(TRaceEnum) do 118 | Add(Races.GetName(R)); 119 | 120 | inherited Render; 121 | 122 | Terminal.ForegroundColor(clGray); 123 | Terminal.Print(DX, CY - (CY div 2), CX, CY, 124 | _(Races.GetDescription(Player.HRace)), TK_ALIGN_BOTTOM); 125 | 126 | AddKey('Enter', _('Confirm')); 127 | AddKey('Esc', _('Back')); 128 | AddKey('?', _('Help'), True); 129 | end; 130 | 131 | class procedure TSceneRace.RenderInfo; 132 | begin 133 | 134 | end; 135 | 136 | procedure TSceneRace.ReRoll; 137 | var 138 | V: TRaceProp; 139 | Age, Height, Weight, Metabolism: Integer; 140 | begin 141 | V := RaceProp[Player.HRace]; 142 | 143 | Age := Math.RandomRange(V.Age.Min, V.Age.Max + 1); 144 | Player.Statictics.SetValue(stAge, Age); 145 | 146 | Height := Math.RandomRange(V.Height.Min, V.Height.Max + 1); 147 | Player.Statictics.SetValue(stHeight, Height); 148 | 149 | Weight := Math.RandomRange(V.Weight.Min, V.Weight.Max + 1); 150 | Player.Statictics.SetValue(stWeight, Weight); 151 | 152 | Metabolism := Math.EnsureRange(Math.RandomRange(V.Metabolism.Min, 153 | V.Metabolism.Max + 1) + Round(Height div 50) + Round(Weight div 15), 154 | MetabolismMin, MetabolismMax); 155 | Player.Statictics.SetValue(stMetabolism, Metabolism); 156 | 157 | // Attributes 158 | Player.Attributes.SetPrm(atStr, Math.RandomRange(V.Strength.Min, 159 | V.Strength.Max + 1)); 160 | PrmAt[atStr] := Player.Attributes.Attrib[atStr].Prm; 161 | Player.Attributes.SetPrm(atDex, Math.RandomRange(V.Dexterity.Min, 162 | V.Dexterity.Max + 1)); 163 | PrmAt[atDex] := Player.Attributes.Attrib[atDex].Prm; 164 | Player.Attributes.SetPrm(atWil, Math.RandomRange(V.Willpower.Min, 165 | V.Willpower.Max + 1)); 166 | PrmAt[atWil] := Player.Attributes.Attrib[atWil].Prm; 167 | Player.Attributes.SetPrm(atPer, Math.RandomRange(V.Perception.Min, 168 | V.Perception.Max + 1)); 169 | PrmAt[atPer] := Player.Attributes.Attrib[atPer].Prm; 170 | 171 | // Life and Mana 172 | Player.Attributes.SetPrm(atLife, Math.RandomRange(V.Life.Min, 173 | V.Life.Max + 1)); 174 | PrmAt[atLife] := Player.Attributes.Attrib[atLife].Prm; 175 | Player.Attributes.SetPrm(atMana, Math.RandomRange(V.Mana.Min, 176 | V.Mana.Max + 1)); 177 | PrmAt[atMana] := Player.Attributes.Attrib[atMana].Prm; 178 | end; 179 | 180 | procedure TSceneRace.SelRand; 181 | var 182 | R: TRaceEnum; 183 | begin 184 | R := Player.HRace; 185 | repeat 186 | Player.HRace := TRaceEnum(Math.RandomRange(0, Ord(High(TRaceEnum)) + 1)); 187 | until (R <> Player.HRace); 188 | end; 189 | 190 | procedure TSceneRace.Update(var Key: UInt); 191 | var 192 | I: Int; 193 | begin 194 | case Key of 195 | TK_TAB: 196 | begin 197 | if (Player.Sex = sxMale) then 198 | Player.Sex := sxFemale 199 | else 200 | Player.Sex := sxMale; 201 | ReRoll; 202 | end; 203 | TK_A .. TK_Z: 204 | begin 205 | I := Ord(Key) - Ord(TK_A); 206 | if (I > Ord(High(TRaceEnum))) then 207 | Exit; 208 | Player.HRace := TRaceEnum(Math.EnsureRange(I, 0, Ord(High(TRaceEnum)))); 209 | ReRoll; 210 | end; 211 | TK_ENTER, TK_KP_ENTER: 212 | begin 213 | (Scenes.GetScene(scClass) as TSceneClass).ReRoll; 214 | Scenes.SetScene(scClass, scRace); 215 | end; 216 | TK_ESCAPE: 217 | begin 218 | Scenes.SetScene(scTitle); 219 | end; 220 | TK_BACKSPACE: 221 | begin 222 | SelRand; 223 | ReRoll; 224 | end; 225 | TK_SLASH: 226 | Scenes.SetScene(scHelp, scRace); 227 | TK_SPACE: 228 | ReRoll; 229 | end; 230 | end; 231 | 232 | { TSceneClass } 233 | 234 | procedure TSceneClass.Render; 235 | var 236 | I: UInt; 237 | C: TClassEnum; 238 | 239 | procedure Add(const AName: string); 240 | var 241 | L: Char; 242 | begin 243 | L := Chr(I + Ord('A')); 244 | Terminal.ForegroundColor(clWhite); 245 | Terminal.Print(1, Y, UI.KeyToStr(L)); 246 | if (C = Player.HClass) then 247 | Terminal.ForegroundColor(clYellow) 248 | else 249 | Terminal.ForegroundColor(clWhite); 250 | Terminal.Print(5, Y, AName); 251 | Inc(I); 252 | Inc(Y); 253 | end; 254 | 255 | begin 256 | UI.Title(_('Choose a class')); 257 | I := 0; 258 | Y := 2; 259 | for C := Low(TClassEnum) to High(TClassEnum) do 260 | Add(Trollhunter.Player.Classes.Classes.GetName(C)); 261 | 262 | inherited Render; 263 | 264 | Terminal.Print(DX, 17, _('Items') + ': ' + Terminal.Colorize 265 | (Classes.GetItems(Player.HClass), 'Lush')); 266 | 267 | Terminal.Print(DX, 19, _('Skills') + ': ' + Terminal.Colorize 268 | (Classes.GetSkills(Player.HClass), 'Lush')); 269 | 270 | Terminal.ForegroundColor(clGray); 271 | Terminal.Print(DX, CY - (CY div 2), CX, CY, 272 | _(Classes.GetDescription(Player.HClass)), TK_ALIGN_BOTTOM); 273 | 274 | AddKey('Enter', _('Confirm')); 275 | AddKey('Esc', _('Back')); 276 | AddKey('?', _('Help'), True); 277 | end; 278 | 279 | procedure TSceneClass.ReRoll; 280 | var 281 | V: TClassProp; 282 | begin 283 | V := ClassProp[Player.HClass]; 284 | 285 | // Attributes 286 | Player.Attributes.SetPrm(atStr, Math.RandomRange(V.Strength.Min, 287 | V.Strength.Max + 1) + PrmAt[atStr]); 288 | Player.Attributes.SetPrm(atDex, Math.RandomRange(V.Dexterity.Min, 289 | V.Dexterity.Max + 1) + PrmAt[atDex]); 290 | Player.Attributes.SetPrm(atWil, Math.RandomRange(V.Willpower.Min, 291 | V.Willpower.Max + 1) + PrmAt[atWil]); 292 | Player.Attributes.SetPrm(atPer, Math.RandomRange(V.Perception.Min, 293 | V.Perception.Max + 1) + PrmAt[atPer]); 294 | 295 | // Life and Mana 296 | Player.Attributes.SetPrm(atLife, Math.RandomRange(V.Life.Min, V.Life.Max + 1) 297 | + PrmAt[atLife]); 298 | Player.Attributes.SetPrm(atMana, Math.RandomRange(V.Mana.Min, V.Mana.Max + 1) 299 | + PrmAt[atMana]); 300 | end; 301 | 302 | procedure TSceneClass.SelRand; 303 | var 304 | C: TClassEnum; 305 | begin 306 | C := Player.HClass; 307 | repeat 308 | Player.HClass := TClassEnum(Math.RandomRange(0, Ord(High(TClassEnum)) + 1)); 309 | until (C <> Player.HClass); 310 | end; 311 | 312 | procedure TSceneClass.Update(var Key: UInt); 313 | var 314 | I: Int; 315 | begin 316 | case Key of 317 | TK_A .. TK_Z: 318 | begin 319 | I := Ord(Key) - Ord(TK_A); 320 | if (I > Ord(High(TClassEnum))) then 321 | Exit; 322 | Player.HClass := 323 | TClassEnum(Math.EnsureRange(I, 0, Ord(High(TClassEnum)))); 324 | ReRoll; 325 | end; 326 | TK_ENTER, TK_KP_ENTER: 327 | begin 328 | Scenes.SetScene(scTalents, scClass); 329 | end; 330 | TK_ESCAPE: 331 | begin 332 | Scenes.SetScene(scRace); 333 | end; 334 | TK_BACKSPACE: 335 | begin 336 | SelRand; 337 | ReRoll; 338 | end; 339 | TK_SLASH: 340 | Scenes.SetScene(scHelp, scClass); 341 | TK_SPACE: 342 | ReRoll; 343 | end; 344 | end; 345 | 346 | end. 347 | -------------------------------------------------------------------------------- /Trollhunter.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | <UseAppBundle Value="False"/> 14 | <ResourceType Value="res"/> 15 | </General> 16 | <i18n> 17 | <EnableI18N LFM="False"/> 18 | </i18n> 19 | <BuildModes Count="1"> 20 | <Item1 Name="Default" Default="True"/> 21 | </BuildModes> 22 | <PublishOptions> 23 | <Version Value="2"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <local> 27 | <CommandLineParams Value="-w -l"/> 28 | </local> 29 | <FormatVersion Value="2"/> 30 | <Modes Count="1"> 31 | <Mode0 Name="default"> 32 | <local> 33 | <CommandLineParams Value="-w -l"/> 34 | </local> 35 | </Mode0> 36 | </Modes> 37 | </RunParams> 38 | <Units Count="60"> 39 | <Unit0> 40 | <Filename Value="Trollhunter.dpr"/> 41 | <IsPartOfProject Value="True"/> 42 | </Unit0> 43 | <Unit1> 44 | <Filename Value="sources\BearLibTerminal\BearLibTerminal.pas"/> 45 | <IsPartOfProject Value="True"/> 46 | </Unit1> 47 | <Unit2> 48 | <Filename Value="sources\BearLibPathFind\uPathFind.pas"/> 49 | <IsPartOfProject Value="True"/> 50 | </Unit2> 51 | <Unit3> 52 | <Filename Value="sources\BearLibItems\uBearLibItemsCommon.pas"/> 53 | <IsPartOfProject Value="True"/> 54 | </Unit3> 55 | <Unit4> 56 | <Filename Value="sources\BearLibItems\uBearLibItemsDungeon.pas"/> 57 | <IsPartOfProject Value="True"/> 58 | </Unit4> 59 | <Unit5> 60 | <Filename Value="sources\BearLibItems\uBearLibItemsInventory.pas"/> 61 | <IsPartOfProject Value="True"/> 62 | </Unit5> 63 | <Unit6> 64 | <Filename Value="sources\uTypes.pas"/> 65 | <IsPartOfProject Value="True"/> 66 | </Unit6> 67 | <Unit7> 68 | <Filename Value="sources\uGame.pas"/> 69 | <IsPartOfProject Value="True"/> 70 | </Unit7> 71 | <Unit8> 72 | <Filename Value="sources\uLanguage.pas"/> 73 | <IsPartOfProject Value="True"/> 74 | </Unit8> 75 | <Unit9> 76 | <Filename Value="sources\uTerminal.pas"/> 77 | <IsPartOfProject Value="True"/> 78 | </Unit9> 79 | <Unit10> 80 | <Filename Value="sources\uScenes.pas"/> 81 | <IsPartOfProject Value="True"/> 82 | </Unit10> 83 | <Unit11> 84 | <Filename Value="sources\uPlayer.pas"/> 85 | <IsPartOfProject Value="True"/> 86 | </Unit11> 87 | <Unit12> 88 | <Filename Value="sources\uMap.pas"/> 89 | <IsPartOfProject Value="True"/> 90 | </Unit12> 91 | <Unit13> 92 | <Filename Value="sources\uItem.pas"/> 93 | <IsPartOfProject Value="True"/> 94 | </Unit13> 95 | <Unit14> 96 | <Filename Value="sources\uMob.pas"/> 97 | <IsPartOfProject Value="True"/> 98 | </Unit14> 99 | <Unit15> 100 | <Filename Value="sources\uMsgLog.pas"/> 101 | <IsPartOfProject Value="True"/> 102 | </Unit15> 103 | <Unit16> 104 | <Filename Value="sources\uCorpse.pas"/> 105 | <IsPartOfProject Value="True"/> 106 | </Unit16> 107 | <Unit17> 108 | <Filename Value="sources\uEntity.pas"/> 109 | <IsPartOfProject Value="True"/> 110 | </Unit17> 111 | <Unit18> 112 | <Filename Value="sources\uCalendar.pas"/> 113 | <IsPartOfProject Value="True"/> 114 | </Unit18> 115 | <Unit19> 116 | <Filename Value="sources\uShop.pas"/> 117 | <IsPartOfProject Value="True"/> 118 | </Unit19> 119 | <Unit20> 120 | <Filename Value="sources\uSpellbook.pas"/> 121 | <IsPartOfProject Value="True"/> 122 | </Unit20> 123 | <Unit21> 124 | <Filename Value="sources\uTalent.pas"/> 125 | <IsPartOfProject Value="True"/> 126 | </Unit21> 127 | <Unit22> 128 | <Filename Value="sources\uAbility.pas"/> 129 | <IsPartOfProject Value="True"/> 130 | </Unit22> 131 | <Unit23> 132 | <Filename Value="sources\uSkill.pas"/> 133 | <IsPartOfProject Value="True"/> 134 | </Unit23> 135 | <Unit24> 136 | <Filename Value="sources\uLogo.pas"/> 137 | <IsPartOfProject Value="True"/> 138 | </Unit24> 139 | <Unit25> 140 | <Filename Value="sources\uStatistic.pas"/> 141 | <IsPartOfProject Value="True"/> 142 | </Unit25> 143 | <Unit26> 144 | <Filename Value="sources\uAffixes.pas"/> 145 | <IsPartOfProject Value="True"/> 146 | </Unit26> 147 | <Unit27> 148 | <Filename Value="sources\uCreature.pas"/> 149 | <IsPartOfProject Value="True"/> 150 | </Unit27> 151 | <Unit28> 152 | <Filename Value="sources\uAttribute.pas"/> 153 | <IsPartOfProject Value="True"/> 154 | </Unit28> 155 | <Unit29> 156 | <Filename Value="sources\uUI.pas"/> 157 | <IsPartOfProject Value="True"/> 158 | </Unit29> 159 | <Unit30> 160 | <Filename Value="sources\uQuest.pas"/> 161 | <IsPartOfProject Value="True"/> 162 | </Unit30> 163 | <Unit31> 164 | <Filename Value="sources\uHelpers.pas"/> 165 | <IsPartOfProject Value="True"/> 166 | </Unit31> 167 | <Unit32> 168 | <Filename Value="sources\uWeather.pas"/> 169 | <IsPartOfProject Value="True"/> 170 | </Unit32> 171 | <Unit33> 172 | <Filename Value="sources\Trollhunter.Item.Shop.pas"/> 173 | <IsPartOfProject Value="True"/> 174 | </Unit33> 175 | <Unit34> 176 | <Filename Value="sources\uRace.pas"/> 177 | <IsPartOfProject Value="True"/> 178 | </Unit34> 179 | <Unit35> 180 | <Filename Value="sources\uClass.pas"/> 181 | <IsPartOfProject Value="True"/> 182 | </Unit35> 183 | <Unit36> 184 | <Filename Value="sources\Trollhunter.Scene.Enchant.pas"/> 185 | <IsPartOfProject Value="True"/> 186 | </Unit36> 187 | <Unit37> 188 | <Filename Value="sources\Trollhunter.Scene.Name.pas"/> 189 | <IsPartOfProject Value="True"/> 190 | </Unit37> 191 | <Unit38> 192 | <Filename Value="sources\Trollhunter.Scene.Rest.pas"/> 193 | <IsPartOfProject Value="True"/> 194 | </Unit38> 195 | <Unit39> 196 | <Filename Value="sources\Trollhunter.Scene.RacesAndClasses.pas"/> 197 | <IsPartOfProject Value="True"/> 198 | </Unit39> 199 | <Unit40> 200 | <Filename Value="sources\Trollhunter.Scene.Quest.pas"/> 201 | <IsPartOfProject Value="True"/> 202 | </Unit40> 203 | <Unit41> 204 | <Filename Value="sources\uUtils.pas"/> 205 | <IsPartOfProject Value="True"/> 206 | </Unit41> 207 | <Unit42> 208 | <Filename Value="sources\Trollhunter.Scene.Background.pas"/> 209 | <IsPartOfProject Value="True"/> 210 | </Unit42> 211 | <Unit43> 212 | <Filename Value="sources\Trollhunter.Item.Types.pas"/> 213 | <IsPartOfProject Value="True"/> 214 | </Unit43> 215 | <Unit44> 216 | <Filename Value="sources\Trollhunter.Types.pas"/> 217 | <IsPartOfProject Value="True"/> 218 | </Unit44> 219 | <Unit45> 220 | <Filename Value="sources\Trollhunter.Terminal.pas"/> 221 | <IsPartOfProject Value="True"/> 222 | </Unit45> 223 | <Unit46> 224 | <Filename Value="sources\Trollhunter.UI.Log.pas"/> 225 | <IsPartOfProject Value="True"/> 226 | </Unit46> 227 | <Unit47> 228 | <Filename Value="sources\Trollhunter.UI.Logo.pas"/> 229 | <IsPartOfProject Value="True"/> 230 | </Unit47> 231 | <Unit48> 232 | <Filename Value="sources\Trollhunter.Item.Affixes.pas"/> 233 | <IsPartOfProject Value="True"/> 234 | </Unit48> 235 | <Unit49> 236 | <Filename Value="sources\Trollhunter.UI.pas"/> 237 | <IsPartOfProject Value="True"/> 238 | </Unit49> 239 | <Unit50> 240 | <Filename Value="sources\Trollhunter.Utils.pas"/> 241 | <IsPartOfProject Value="True"/> 242 | </Unit50> 243 | <Unit51> 244 | <Filename Value="sources\Trollhunter.Player.Types.pas"/> 245 | <IsPartOfProject Value="True"/> 246 | </Unit51> 247 | <Unit52> 248 | <Filename Value="sources\Trollhunter.Player.pas"/> 249 | <IsPartOfProject Value="True"/> 250 | </Unit52> 251 | <Unit53> 252 | <Filename Value="sources\Trollhunter.Statistic.pas"/> 253 | <IsPartOfProject Value="True"/> 254 | </Unit53> 255 | <Unit54> 256 | <Filename Value="sources\Trollhunter.Player.Races.pas"/> 257 | <IsPartOfProject Value="True"/> 258 | </Unit54> 259 | <Unit55> 260 | <Filename Value="sources\Trollhunter.Player.Classes.pas"/> 261 | <IsPartOfProject Value="True"/> 262 | </Unit55> 263 | <Unit56> 264 | <Filename Value="sources\Trollhunter.Scene.Statistics.pas"/> 265 | <IsPartOfProject Value="True"/> 266 | </Unit56> 267 | <Unit57> 268 | <Filename Value="sources\Trollhunter.Scene.Options.pas"/> 269 | <IsPartOfProject Value="True"/> 270 | </Unit57> 271 | <Unit58> 272 | <Filename Value="sources\Trollhunter.Player.Helpers.pas"/> 273 | <IsPartOfProject Value="True"/> 274 | </Unit58> 275 | <Unit59> 276 | <Filename Value="sources\Trollhunter.Scene.Help.pas"/> 277 | <IsPartOfProject Value="True"/> 278 | </Unit59> 279 | </Units> 280 | </ProjectOptions> 281 | <CompilerOptions> 282 | <Version Value="11"/> 283 | <PathDelim Value="\"/> 284 | <Target> 285 | <Filename Value="Trollhunter"/> 286 | </Target> 287 | <SearchPaths> 288 | <IncludeFiles Value="$(ProjOutDir)"/> 289 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 290 | </SearchPaths> 291 | <Parsing> 292 | <SyntaxOptions> 293 | <SyntaxMode Value="Delphi"/> 294 | <CStyleOperator Value="False"/> 295 | <AllowLabel Value="False"/> 296 | <UseAnsiStrings Value="False"/> 297 | <CPPInline Value="False"/> 298 | </SyntaxOptions> 299 | </Parsing> 300 | <Linking> 301 | <Debugging> 302 | <DebugInfoType Value="dsDwarf2Set"/> 303 | </Debugging> 304 | </Linking> 305 | </CompilerOptions> 306 | <Debugging> 307 | <Exceptions Count="3"> 308 | <Item1> 309 | <Name Value="EAbort"/> 310 | </Item1> 311 | <Item2> 312 | <Name Value="ECodetoolError"/> 313 | </Item2> 314 | <Item3> 315 | <Name Value="EFOpenError"/> 316 | </Item3> 317 | </Exceptions> 318 | </Debugging> 319 | </CONFIG> 320 | -------------------------------------------------------------------------------- /sources/BearLibTerminal/BearLibTerminal.pas: -------------------------------------------------------------------------------- 1 | {* 2 | * BearLibTerminal 3 | * Copyright (C) 2013-2017 Cfyz, Apromix 4 | * 5 | * Permission is hereby granted, free of charge, to any person obtaining a copy 6 | * of this software and associated documentation files (the "Software"), to deal 7 | * in the Software without restriction, including without limitation the rights 8 | * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 9 | * of the Software, and to permit persons to whom the Software is furnished to do 10 | * so, subject to the following conditions: 11 | * 12 | * The above copyright notice and this permission notice shall be included in all 13 | * copies or substantial portions of the Software. 14 | * 15 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | * FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | *} 22 | 23 | {$H+} 24 | 25 | unit BearLibTerminal; 26 | 27 | interface 28 | 29 | uses 30 | Types; 31 | 32 | const 33 | // Keyboard scancodes 34 | TK_A = $04; 35 | TK_B = $05; 36 | TK_C = $06; 37 | TK_D = $07; 38 | TK_E = $08; 39 | TK_F = $09; 40 | TK_G = $0A; 41 | TK_H = $0B; 42 | TK_I = $0C; 43 | TK_J = $0D; 44 | TK_K = $0E; 45 | TK_L = $0F; 46 | TK_M = $10; 47 | TK_N = $11; 48 | TK_O = $12; 49 | TK_P = $13; 50 | TK_Q = $14; 51 | TK_R = $15; 52 | TK_S = $16; 53 | TK_T = $17; 54 | TK_U = $18; 55 | TK_V = $19; 56 | TK_W = $1A; 57 | TK_X = $1B; 58 | TK_Y = $1C; 59 | TK_Z = $1D; 60 | TK_1 = $1E; 61 | TK_2 = $1F; 62 | TK_3 = $20; 63 | TK_4 = $21; 64 | TK_5 = $22; 65 | TK_6 = $23; 66 | TK_7 = $24; 67 | TK_8 = $25; 68 | TK_9 = $26; 69 | TK_0 = $27; 70 | TK_RETURN = $28; 71 | TK_ENTER = $28; 72 | TK_ESCAPE = $29; 73 | TK_BACKSPACE = $2A; 74 | TK_TAB = $2B; 75 | TK_SPACE = $2C; 76 | TK_MINUS = $2D; 77 | TK_EQUALS = $2E; 78 | TK_LBRACKET = $2F; 79 | TK_RBRACKET = $30; 80 | TK_BACKSLASH = $31; 81 | TK_SEMICOLON = $33; 82 | TK_APOSTROPHE = $34; 83 | TK_GRAVE = $35; 84 | TK_COMMA = $36; 85 | TK_PERIOD = $37; 86 | TK_SLASH = $38; 87 | TK_F1 = $3A; 88 | TK_F2 = $3B; 89 | TK_F3 = $3C; 90 | TK_F4 = $3D; 91 | TK_F5 = $3E; 92 | TK_F6 = $3F; 93 | TK_F7 = $40; 94 | TK_F8 = $41; 95 | TK_F9 = $42; 96 | TK_F10 = $43; 97 | TK_F11 = $44; 98 | TK_F12 = $45; 99 | TK_PAUSE = $48; 100 | TK_INSERT = $49; 101 | TK_HOME = $4A; 102 | TK_PAGEUP = $4B; 103 | TK_DELETE = $4C; 104 | TK_END = $4D; 105 | TK_PAGEDOWN = $4E; 106 | TK_RIGHT = $4F; 107 | TK_LEFT = $50; 108 | TK_DOWN = $51; 109 | TK_UP = $52; 110 | TK_KP_DIVIDE = $54; 111 | TK_KP_MULTIPLY = $55; 112 | TK_KP_MINUS = $56; 113 | TK_KP_PLUS = $57; 114 | TK_KP_ENTER = $58; 115 | TK_KP_1 = $59; 116 | TK_KP_2 = $5A; 117 | TK_KP_3 = $5B; 118 | TK_KP_4 = $5C; 119 | TK_KP_5 = $5D; 120 | TK_KP_6 = $5E; 121 | TK_KP_7 = $5F; 122 | TK_KP_8 = $60; 123 | TK_KP_9 = $61; 124 | TK_KP_0 = $62; 125 | TK_KP_PERIOD = $63; 126 | TK_SHIFT = $70; 127 | TK_CONTROL = $71; 128 | TK_ALT = $72; 129 | 130 | // Mouse events/states 131 | TK_MOUSE_LEFT = $80; // Buttons 132 | TK_MOUSE_RIGHT = $81; 133 | TK_MOUSE_MIDDLE = $82; 134 | TK_MOUSE_X1 = $83; 135 | TK_MOUSE_X2 = $84; 136 | TK_MOUSE_MOVE = $85; // Movement event 137 | TK_MOUSE_SCROLL = $86; // Mouse scroll event 138 | TK_MOUSE_X = $87; // Cusor position in cells 139 | TK_MOUSE_Y = $88; 140 | TK_MOUSE_PIXEL_X = $89; // Cursor position in pixels 141 | TK_MOUSE_PIXEL_Y = $8A; 142 | TK_MOUSE_WHEEL = $8B; // Scroll direction and amount 143 | TK_MOUSE_CLICKS = $8C; // Number of consecutive clicks 144 | 145 | // If key was released instead of pressed, it's code will be OR'ed with TK_KEY_RELEASED 146 | TK_KEY_RELEASED = $100; 147 | 148 | // Virtual key-codes for internal terminal states/variables. 149 | // These can be accessed via terminal_state function. 150 | TK_WIDTH = $C0; // Terminal window size in cells 151 | TK_HEIGHT = $C1; 152 | TK_CELL_WIDTH = $C2; // Character cell size in pixels 153 | TK_CELL_HEIGHT = $C3; 154 | TK_COLOR = $C4; // Current foregroung color 155 | TK_BKCOLOR = $C5; // Current background color 156 | TK_LAYER = $C6; // Current layer 157 | TK_COMPOSITION = $C7; // Current composition state 158 | TK_CHAR = $C8; // Translated ANSI code of last produced character 159 | TK_WCHAR = $C9; // Unicode codepoint of last produced character 160 | TK_EVENT = $CA; // Last dequeued event 161 | TK_FULLSCREEN = $CB; // Fullscreen state 162 | 163 | //Other events 164 | TK_CLOSE = $E0; 165 | TK_RESIZED = $E1; 166 | 167 | // Generic mode enum. 168 | // Right now it is used for composition option only. 169 | TK_OFF = 0; 170 | TK_ON = 1; 171 | 172 | // Input result codes for terminal_read function. 173 | TK_INPUT_NONE = 0; 174 | TK_INPUT_CANCELLED = -1; 175 | 176 | // Text alignment. 177 | TK_ALIGN_DEFAULT = 0; 178 | TK_ALIGN_LEFT = 1; 179 | TK_ALIGN_RIGHT = 2; 180 | TK_ALIGN_CENTER = 3; 181 | TK_ALIGN_TOP = 4; 182 | TK_ALIGN_BOTTOM = 8; 183 | TK_ALIGN_MIDDLE = 12; 184 | 185 | // ---------------------------------------------------------------------------- 186 | // Module interface 187 | // ---------------------------------------------------------------------------- 188 | 189 | {$IFNDEF FPC} 190 | type 191 | UInt8 = Byte; 192 | Int32 = Integer; 193 | PInt32 = ^Integer; 194 | UInt32 = Cardinal; 195 | PUInt32 = ^Cardinal; 196 | {$ENDIF} 197 | 198 | type 199 | TSize = Types.TSize; 200 | 201 | // Open 202 | function terminal_open(): LongBool; 203 | cdecl; external 'BearLibTerminal' name 'terminal_open'; 204 | 205 | // Close 206 | procedure terminal_close(); 207 | cdecl; external 'BearLibTerminal' name 'terminal_close'; 208 | 209 | // Set 210 | function terminal_set(const Options: AnsiString): LongBool; overload; 211 | 212 | function terminal_set(const Options: WideString): LongBool; overload; 213 | 214 | // Refresh 215 | procedure terminal_refresh(); 216 | cdecl; external 'BearLibTerminal' name 'terminal_refresh'; 217 | 218 | // Clear 219 | procedure terminal_clear(); 220 | cdecl; external 'BearLibTerminal' name 'terminal_clear'; 221 | 222 | // ClearArea 223 | procedure terminal_clear_area(const Left, Top, Width, Height: Int32); 224 | cdecl; external 'BearLibTerminal' name 'terminal_clear_area'; 225 | 226 | // Crop 227 | procedure terminal_crop(const Left, Top, Width, Height: Int32); 228 | cdecl; external 'BearLibTerminal' name 'terminal_crop'; 229 | 230 | // Color 231 | procedure terminal_color(const Color: UInt32); overload; 232 | cdecl; external 'BearLibTerminal' name 'terminal_color'; 233 | 234 | procedure terminal_color(const Color: AnsiString); overload; 235 | 236 | procedure terminal_color(const Color: WideString); overload; 237 | 238 | // BkColor 239 | procedure terminal_bkcolor(const Color: UInt32); overload; 240 | cdecl; external 'BearLibTerminal' name 'terminal_bkcolor'; 241 | 242 | procedure terminal_bkcolor(const Color: AnsiString); overload; 243 | 244 | procedure terminal_bkcolor(const Color: WideString); overload; 245 | 246 | // Composition 247 | procedure terminal_composition(const Mode: Int32); 248 | cdecl; external 'BearLibTerminal' name 'terminal_composition'; 249 | 250 | // Layer 251 | procedure terminal_layer(const Mode: Int32); 252 | cdecl; external 'BearLibTerminal' name 'terminal_layer'; 253 | 254 | // Font 255 | procedure terminal_font(const Name: AnsiString); overload; 256 | 257 | procedure terminal_font(const Name: WideString); overload; 258 | 259 | // Put 260 | procedure terminal_put(const X, Y, Code: Int32); overload; 261 | 262 | procedure terminal_put(const X, Y: Int32; const Code: AnsiChar); overload; 263 | 264 | procedure terminal_put(const X, Y: Int32; const Code: WideChar); overload; 265 | 266 | // PutExt 267 | procedure terminal_put_ext(const X, Y, dX, dY: Int32; const Code: Int32; const Corners: PUInt32); overload; 268 | cdecl; external 'BearLibTerminal' name 'terminal_put_ext'; 269 | 270 | procedure terminal_put_ext(const X, Y, dX, dY: Int32; const Code: WideChar; const Corners: PUInt32); overload; 271 | 272 | procedure terminal_put_ext(const X, Y, dX, dY, Code: Int32); overload; 273 | 274 | procedure terminal_put_ext(const X, Y, dX, dY: Int32; const Code: WideChar); overload; 275 | 276 | // Pick 277 | function terminal_pick(const X, Y, Index: Int32): Int32; overload; 278 | cdecl; external 'BearLibTerminal' name 'terminal_pick'; 279 | 280 | function terminal_pick(const X, Y: Int32): Int32; overload; 281 | 282 | // PickColor 283 | function terminal_pick_color(const X, Y, Index: Int32): UInt32; overload; 284 | cdecl; external 'BearLibTerminal' name 'terminal_pick_color'; 285 | 286 | function terminal_pick_color(const X, Y: Int32): UInt32; overload; 287 | 288 | // PickBkColor 289 | function terminal_pick_bkcolor(const X, Y: Int32): UInt32; 290 | cdecl; external 'BearLibTerminal' name 'terminal_pick_bkcolor'; 291 | 292 | // Print 293 | function terminal_print(const X, Y: Int32; const S: AnsiString): TSize; overload; 294 | 295 | function terminal_print(const X, Y: Int32; const S: WideString): TSize; overload; 296 | 297 | function terminal_print(const X, Y, Alignment: Int32; const S: AnsiString): TSize; overload; 298 | 299 | function terminal_print(const X, Y, Alignment: Int32; const S: WideString): TSize; overload; 300 | 301 | function terminal_print(const X, Y, Width, Height, Alignment: Int32; const S: AnsiString): TSize; overload; 302 | 303 | function terminal_print(const X, Y, Width, Height, Alignment: Int32; const S: WideString): TSize; overload; 304 | 305 | // Measure 306 | function terminal_measure(const S: AnsiString): TSize; overload; 307 | 308 | function terminal_measure(const S: WideString): TSize; overload; 309 | 310 | function terminal_measure(const Width, Height: Int32; const S: AnsiString): TSize; overload; 311 | 312 | function terminal_measure(const Width, Height: Int32; const S: WideString): TSize; overload; 313 | 314 | // HasInput 315 | function terminal_has_input(): LongBool; 316 | cdecl; external 'BearLibTerminal' name 'terminal_has_input'; 317 | 318 | // State 319 | function terminal_state(const Code: Int32): Int32; 320 | cdecl; external 'BearLibTerminal' name 'terminal_state'; 321 | 322 | // Check 323 | function terminal_check(const Code: Int32): Boolean; 324 | 325 | // Read 326 | function terminal_read(): Int32; 327 | cdecl; external 'BearLibTerminal' name 'terminal_read'; 328 | 329 | // ReadStr 330 | function terminal_read_str(const X, Y: Int32; var S: AnsiString; const MaxLength: Int32): Int32; overload; 331 | 332 | function terminal_read_str(const X, Y: Int32; var S: WideString; const MaxLength: Int32): Int32; overload; 333 | 334 | // Peek 335 | function terminal_peek(): Int32; 336 | cdecl; external 'BearLibTerminal' name 'terminal_peek'; 337 | 338 | // Delay 339 | procedure terminal_delay(Period: Int32); 340 | cdecl; external 'BearLibTerminal' name 'terminal_delay'; 341 | 342 | // Get 343 | function terminal_get(const S: AnsiString): AnsiString; overload; 344 | 345 | function terminal_get(const S, Default: AnsiString): AnsiString; overload; 346 | 347 | function terminal_get(const S: WideString): WideString; overload; 348 | 349 | function terminal_get(const S, Default: WideString): WideString; overload; 350 | 351 | // ColorFromName 352 | function color_from_name(const Name: AnsiString): UInt32; overload; 353 | 354 | function color_from_name(const Name: WideString): UInt32; overload; 355 | 356 | // ColorFromARGB 357 | function color_from_argb(const A, R, G, B: UInt8): UInt32; 358 | 359 | // ---------------------------------------------------------------------------- 360 | // Module implementation 361 | // ---------------------------------------------------------------------------- 362 | 363 | implementation 364 | 365 | function terminal_set_ansi(const Options: PAnsiChar): LongBool; 366 | cdecl; external 'BearLibTerminal' name 'terminal_set8'; 367 | 368 | function terminal_set(const Options: AnsiString): LongBool; 369 | begin 370 | terminal_set := terminal_set_ansi(PAnsiChar(Options)); 371 | end; 372 | 373 | function terminal_set_unicode(const Options: PWideChar): LongBool; 374 | cdecl; external 'BearLibTerminal' name 'terminal_set16'; 375 | 376 | function terminal_set(const Options: WideString): LongBool; 377 | begin 378 | terminal_set := terminal_set_unicode(PWideChar(Options)); 379 | end; 380 | 381 | procedure terminal_color(const Color: AnsiString); overload; 382 | begin 383 | terminal_color(color_from_name(Color)); 384 | end; 385 | 386 | procedure terminal_color(const Color: WideString); overload; 387 | begin 388 | terminal_color(color_from_name(Color)); 389 | end; 390 | 391 | procedure terminal_bkcolor(const Color: AnsiString); overload; 392 | begin 393 | terminal_bkcolor(color_from_name(Color)); 394 | end; 395 | 396 | procedure terminal_bkcolor(const Color: WideString); overload; 397 | begin 398 | terminal_bkcolor(color_from_name(Color)); 399 | end; 400 | 401 | procedure terminal_font_ansi(const Name: PAnsiChar); 402 | cdecl; external 'BearLibTerminal' name 'terminal_font8'; 403 | 404 | procedure terminal_font_unicode(const Name: PWideChar); 405 | cdecl; external 'BearLibTerminal' name 'terminal_font16'; 406 | 407 | procedure terminal_font(const Name: AnsiString); overload; 408 | begin 409 | terminal_font_ansi(PAnsiChar(Name)); 410 | end; 411 | 412 | procedure terminal_font(const Name: WideString); overload; 413 | begin 414 | terminal_font_unicode(PWideChar(Name)); 415 | end; 416 | 417 | procedure terminal_put_integer(const X, Y, Code: Int32); 418 | cdecl; external 'BearLibTerminal' name 'terminal_put'; 419 | 420 | procedure terminal_put(const X, Y, Code: Int32); 421 | begin 422 | terminal_put_integer(X, Y, Code); 423 | end; 424 | 425 | procedure terminal_put(const X, Y: Int32; const Code: AnsiChar); 426 | begin 427 | terminal_put_integer(X, Y, ord(Code)); 428 | end; 429 | 430 | procedure terminal_put(const X, Y: Int32; const Code: WideChar); 431 | begin 432 | terminal_put_integer(X, Y, ord(Code)); 433 | end; 434 | 435 | procedure terminal_put_ext(const X, Y, dX, dY: Int32; const Code: WideChar; const Corners: PUInt32); overload; 436 | begin 437 | terminal_put_ext(X, Y, dX, dY, ord(Code), Corners); 438 | end; 439 | 440 | procedure terminal_put_ext(const X, Y, dX, dY, Code: Int32); overload; 441 | begin 442 | terminal_put_ext(X, Y, dX, dY, Code, PUInt32(0)); 443 | end; 444 | 445 | procedure terminal_put_ext(const X, Y, dX, dY: Int32; const Code: WideChar); overload; 446 | begin 447 | terminal_put_ext(X, Y, dX, dY, ord(Code), PUInt32(0)); 448 | end; 449 | 450 | function terminal_pick(const X, Y: Int32): Int32; overload; 451 | begin 452 | terminal_pick := terminal_pick(X, Y, 0); 453 | end; 454 | 455 | function terminal_pick_color(const X, Y: Int32): UInt32; overload; 456 | begin; 457 | terminal_pick_color := terminal_pick_color(X, Y, 0); 458 | end; 459 | 460 | procedure terminal_print_ansi(const X, Y, Width, Height, Alignment: Int32; const S: PAnsiChar; const OutW, OutH: PInt32); 461 | cdecl; external 'BearLibTerminal' name 'terminal_print_ext8'; 462 | 463 | procedure terminal_print_unicode(const X, Y, Width, Height, Alignment: Int32; const S: PWideChar; const OutW, OutH: PInt32); 464 | cdecl; external 'BearLibTerminal' name 'terminal_print_ext16'; 465 | 466 | function terminal_print(const X, Y: Int32; const S: AnsiString): TSize; 467 | begin 468 | terminal_print := terminal_print(X, Y, 0, 0, TK_ALIGN_DEFAULT, S); 469 | end; 470 | 471 | function terminal_print(const X, Y: Int32; const S: WideString): TSize; 472 | begin 473 | terminal_print := terminal_print(X, Y, 0, 0, TK_ALIGN_DEFAULT, S); 474 | end; 475 | 476 | function terminal_print(const X, Y, Alignment: Int32; const S: AnsiString): TSize; 477 | begin 478 | terminal_print := terminal_print(X, Y, 0, 0, Alignment, S); 479 | end; 480 | 481 | function terminal_print(const X, Y, Alignment: Int32; const S: WideString): TSize; 482 | begin 483 | terminal_print := terminal_print(X, Y, 0, 0, Alignment, S); 484 | end; 485 | 486 | function terminal_print(const X, Y, Width, Height, Alignment: Int32; const S: AnsiString): TSize; 487 | var 488 | OutW, OutH: Int32; 489 | begin 490 | terminal_print_ansi(X, Y, Width, Height, Alignment, PAnsiChar(S), @OutW, @OutH); 491 | terminal_print.cx := OutW; 492 | terminal_print.cy := OutH; 493 | end; 494 | 495 | function terminal_print(const X, Y, Width, Height, Alignment: Int32; const S: WideString): TSize; 496 | var 497 | OutW, OutH: Int32; 498 | begin 499 | terminal_print_unicode(X, Y, Width, Height, Alignment, PWideChar(S), @OutW, @OutH); 500 | terminal_print.cx := OutW; 501 | terminal_print.cy := OutH; 502 | end; 503 | 504 | procedure terminal_measure_ansi(const Width, Height: Int32; const S: PAnsiChar; OutW, OutH: PInt32); 505 | cdecl; external 'BearLibTerminal' name 'terminal_measure_ext8'; 506 | 507 | procedure terminal_measure_unicode(const Width, Height: Int32; const S: PWideChar; OutW, OutH: PInt32); 508 | cdecl; external 'BearLibTerminal' name 'terminal_measure_ext16'; 509 | 510 | function terminal_measure(const S: AnsiString): TSize; 511 | begin 512 | terminal_measure := terminal_measure(0, 0, S); 513 | end; 514 | 515 | function terminal_measure(const S: WideString): TSize; 516 | begin 517 | terminal_measure := terminal_measure(0, 0, S); 518 | end; 519 | 520 | function terminal_measure(const Width, Height: Int32; const S: AnsiString): TSize; 521 | var 522 | OutW, OutH: Int32; 523 | begin 524 | terminal_measure_ansi(Width, Height, PAnsiChar(S), @OutW, @OutH); 525 | terminal_measure.cx := OutW; 526 | terminal_measure.cy := OutH; 527 | end; 528 | 529 | function terminal_measure(const Width, Height: Int32; const S: WideString): TSize; 530 | var 531 | OutW, OutH: Int32; 532 | begin 533 | terminal_measure_unicode(Width, Height, PWideChar(S), @OutW, @OutH); 534 | terminal_measure.cx := OutW; 535 | terminal_measure.cy := OutH; 536 | end; 537 | 538 | function terminal_check(const Code: Int32): Boolean; 539 | begin 540 | terminal_check := terminal_state(Code) > 0; 541 | end; 542 | 543 | function terminal_read_str_ansi(const X, Y: Int32; const S: PAnsiChar; const MaxLength: Int32): Int32; 544 | cdecl; external 'BearLibTerminal' name 'terminal_read_str8'; 545 | 546 | function terminal_read_str(const X, Y: Int32; var S: AnsiString; const MaxLength: Int32): Int32; 547 | var 548 | I: Int32; 549 | begin 550 | SetLength(S, MaxLength * 3 + 1); // Bigger size to accomodate possible UTF-8 string. 551 | terminal_read_str := terminal_read_str_ansi(X, Y, PAnsiChar(S), MaxLength); 552 | for I := 1 to MaxLength * 3 + 1 do 553 | if S[I] = AnsiChar(0) then 554 | break; 555 | SetLength(S, I); 556 | end; 557 | 558 | function terminal_read_str_unicode(const X, Y: Int32; S: PWideChar; const MaxLength: Int32): Int32; 559 | cdecl; external 'BearLibTerminal' name 'terminal_read_str16'; 560 | 561 | function terminal_read_str(const X, Y: Int32; var S: WideString; const MaxLength: Int32): Int32; 562 | var 563 | I: Int32; 564 | begin 565 | SetLength(S, MaxLength); 566 | terminal_read_str := terminal_read_str_unicode(X, Y, PWideChar(S), MaxLength); 567 | for I := 1 to MaxLength do 568 | if S[I] = WideChar(0) then 569 | break; 570 | SetLength(S, I); 571 | end; 572 | 573 | function terminal_get_ansi(const S, Default: PAnsiChar): PAnsiChar; 574 | cdecl; external 'BearLibTerminal' name 'terminal_get8'; 575 | 576 | function terminal_get_unicode(const S, Default: PWideChar): PWideChar; 577 | cdecl; external 'BearLibTerminal' name 'terminal_get16'; 578 | 579 | function terminal_get(const S: AnsiString): AnsiString; 580 | begin 581 | terminal_get := terminal_get_ansi(PAnsiChar(S), nil); 582 | end; 583 | 584 | function terminal_get(const S, Default: AnsiString): AnsiString; 585 | begin 586 | terminal_get := terminal_get_ansi(PAnsiChar(S), PAnsiChar(Default)); 587 | end; 588 | 589 | function terminal_get(const S: WideString): WideString; 590 | begin 591 | terminal_get := terminal_get_unicode(PWideChar(S), nil); 592 | end; 593 | 594 | function terminal_get(const S, Default: WideString): WideString; 595 | begin 596 | terminal_get := terminal_get_unicode(PWideChar(S), PWideChar(Default)); 597 | end; 598 | 599 | function color_from_name_ansi(const Name: PAnsiChar): UInt32; 600 | cdecl; external 'BearLibTerminal' name 'color_from_name8'; 601 | 602 | function color_from_name(const Name: AnsiString): UInt32; 603 | begin 604 | color_from_name := color_from_name_ansi(PAnsiChar(Name)); 605 | end; 606 | 607 | function color_from_name_unicode(const Name: PWideChar): UInt32; 608 | cdecl; external 'BearLibTerminal' name 'color_from_name16'; 609 | 610 | function color_from_name(const Name: WideString): UInt32; 611 | begin 612 | color_from_name := color_from_name_unicode(PWideChar(Name)); 613 | end; 614 | 615 | function color_from_argb(const A, R, G, B: UInt8): UInt32; 616 | begin 617 | color_from_argb := (A shl 24) or (R shl 16) or (G shl 8) or B; 618 | end; 619 | 620 | end. 621 | -------------------------------------------------------------------------------- /sources/uMap.pas: -------------------------------------------------------------------------------- 1 | unit uMap; 2 | 3 | interface 4 | 5 | uses Trollhunter.Types; 6 | 7 | type 8 | TMapEnum = (deDark_Wood, deGray_Cave, deDeep_Cave, deBlood_Cave, deDrom); 9 | 10 | const 11 | FinalDungeon = deDrom; 12 | 13 | type 14 | TTile = record 15 | Symbol: Char; 16 | Name: string; 17 | Color: Cardinal; 18 | end; 19 | 20 | type 21 | TTileEnum = (teDefaultFloor, teDefaultWall, teRock, teFloor1, teFloor2, 22 | teFloor3, teUpStairs, teDnStairs, teWater, teStoneWall, teWoodenWall, 23 | teStoneFloor, teWoodenFloor, teDoor, teGate, tePortal, teTownPortal); 24 | 25 | const 26 | StopTiles = [teDefaultWall, teStoneWall, teWoodenWall]; 27 | FreeTiles = [teDefaultFloor, teRock, teFloor1, teFloor2, teFloor3, teUpStairs, 28 | teDnStairs, teWater]; 29 | VillageTiles = [teStoneWall, teWoodenWall, teStoneFloor, teWoodenFloor, 30 | teDoor, teGate]; 31 | SpawnTiles = [teDefaultFloor, teRock, teFloor1, teFloor2, teFloor3, teWater]; 32 | 33 | var 34 | Tile: array [TTileEnum, TMapEnum] of TTile; 35 | 36 | type 37 | MapSize = System.Byte; 38 | 39 | type 40 | TMap = class(TObject) 41 | private 42 | FCurrent: TMapEnum; 43 | FMapName: array [TMapEnum] of string; 44 | FVis: array [TMapEnum] of Boolean; 45 | FMap: array [MapSize, MapSize, TMapEnum] of TTileEnum; 46 | FFog: array [MapSize, MapSize, TMapEnum] of Boolean; 47 | FFOV: array [MapSize, MapSize] of Boolean; 48 | procedure AddSpot(AX, AY: UInt; ASize: UInt; AZ: TMapEnum; 49 | ABaseTileEnum, ATileEnum: TTileEnum); 50 | procedure AddTiles(AX, AY: UInt; AZ: TMapEnum; AType: UInt; ADen: UInt; 51 | ABaseTileEnum, ATileEnum: TTileEnum); 52 | procedure AddTile(ASymbol: Char; AName: string; AColor: Cardinal; 53 | ATile: TTileEnum; AZ: TMapEnum); 54 | procedure InitTiles; 55 | function GetName: string; 56 | public 57 | constructor Create; 58 | destructor Destroy; override; 59 | procedure SetVis(const AZ: TMapEnum; const Value: Boolean); 60 | function GetVis(const AZ: TMapEnum): Boolean; 61 | procedure Clear(Z: TMapEnum; ATileEnum: TTileEnum); 62 | procedure Gen; 63 | property Current: TMapEnum read FCurrent write FCurrent; 64 | function InMap(AX, AY: Int): Boolean; 65 | function InView(AX, AY: Int): Boolean; 66 | function GetFog(AX, AY: UInt): Boolean; 67 | procedure SetFog(AX, AY: UInt; AFlag: Boolean); 68 | procedure ClearFOV; 69 | function GetFOV(AX, AY: UInt): Boolean; 70 | procedure SetFOV(AX, AY: UInt; AFlag: Boolean); 71 | function GetTile(AX, AY: UInt): TTile; overload; 72 | function GetTile(ATileEnum: TTileEnum): TTile; overload; 73 | procedure SetTileEnum(AX, AY: UInt; AZ: TMapEnum; ATileEnum: TTileEnum); 74 | function GetTileEnum(AX, AY: UInt; AZ: TMapEnum): TTileEnum; 75 | property Name: string read GetName; 76 | function EnsureRange(Value: Int): UInt; 77 | end; 78 | 79 | var 80 | IsBoss: Boolean = False; 81 | IsRare: Boolean = False; 82 | 83 | var 84 | Map: TMap = nil; 85 | 86 | implementation 87 | 88 | uses SysUtils, 89 | Math, 90 | Types, 91 | TypInfo, 92 | Trollhunter.Player, 93 | uMob, 94 | uItem, 95 | uLanguage, 96 | Trollhunter.Terminal, 97 | uGame, 98 | uCreature, 99 | uAttribute, 100 | uScenes, 101 | uHelpers; 102 | 103 | { TMap } 104 | 105 | procedure TMap.InitTiles; 106 | begin 107 | // DefaultFloor 108 | AddTile('"', _('Grass'), $FF113311, teDefaultFloor, deDark_Wood); 109 | AddTile(':', _('Dirt'), $FF331133, teDefaultFloor, deGray_Cave); 110 | AddTile('.', _('Stone'), $FF222111, teDefaultFloor, deDeep_Cave); 111 | AddTile(';', _('Stone'), $FF330000, teDefaultFloor, deBlood_Cave); 112 | AddTile('~', _('Stone'), $FF002200, teDefaultFloor, deDrom); 113 | // DefaultWall 114 | AddTile('T', _('Tree'), $FF006622, teDefaultWall, deDark_Wood); 115 | AddTile('#', _('Wall'), $FF444422, teDefaultWall, deGray_Cave); 116 | AddTile('#', _('Wall'), $FF222133, teDefaultWall, deDeep_Cave); 117 | AddTile('#', _('Wall'), $FF322118, teDefaultWall, deBlood_Cave); 118 | AddTile('#', _('Wall'), $FF112211, teDefaultWall, deDrom); 119 | // Rock 120 | AddTile('^', _('Rock'), $FF556655, teRock, deDark_Wood); 121 | AddTile(':', _('Wall'), $FF444422, teRock, deGray_Cave); 122 | AddTile(':', _('Wall'), $FF222133, teRock, deDeep_Cave); 123 | AddTile(':', _('Wall'), $FF322118, teRock, deBlood_Cave); 124 | AddTile(':', _('Wall'), $FF112233, teRock, deDrom); 125 | // Floor #1 126 | AddTile('"', _('Grass'), $FF446644, teFloor1, deDark_Wood); 127 | AddTile('"', _('Grass'), $FF99AA99, teFloor1, deGray_Cave); 128 | AddTile('.', _('Stone'), $FF224422, teFloor1, deDeep_Cave); 129 | AddTile(';', _('Stone'), $FF225533, teFloor1, deBlood_Cave); 130 | AddTile('~', _('Stone'), $FF228833, teFloor1, deDrom); 131 | // Floor #2 132 | AddTile('"', _('Grass'), $FF447755, teFloor2, deDark_Wood); 133 | AddTile('"', _('Grass'), $FF779977, teFloor2, deGray_Cave); 134 | AddTile('.', _('Stone'), $FF22CC44, teFloor2, deDeep_Cave); 135 | AddTile(';', _('Stone'), $FF333322, teFloor2, deBlood_Cave); 136 | AddTile('~', _('Stone'), $FF334422, teFloor2, deDrom); 137 | // Floor #3 138 | AddTile('"', _('Grass'), $FF778866, teFloor3, deDark_Wood); 139 | AddTile('"', _('Grass'), $FF668866, teFloor3, deGray_Cave); 140 | AddTile('.', _('Stone'), $FF338855, teFloor3, deDeep_Cave); 141 | AddTile(';', _('Stone'), $FF223333, teFloor3, deBlood_Cave); 142 | AddTile('~', _('Stone'), $FF226622, teFloor3, deDrom); 143 | // Up Stairs 144 | AddTile('*', _('Stairs'), $FFFFFF00, teUpStairs, deDark_Wood); 145 | AddTile('<', _('Stairs'), $FFEEEE00, teUpStairs, deGray_Cave); 146 | AddTile('<', _('Stairs'), $FFDDDD00, teUpStairs, deDeep_Cave); 147 | AddTile('<', _('Stairs'), $FFCCCC00, teUpStairs, deBlood_Cave); 148 | AddTile('<', _('Stairs'), $FFBBBB00, teUpStairs, deDrom); 149 | // Down Stairs 150 | AddTile('*', _('Stairs'), $FFFFFF00, teDnStairs, deDark_Wood); 151 | AddTile('>', _('Stairs'), $FFEEEE00, teDnStairs, deGray_Cave); 152 | AddTile('>', _('Stairs'), $FFDDDD00, teDnStairs, deDeep_Cave); 153 | AddTile('>', _('Stairs'), $FFCCCC00, teDnStairs, deBlood_Cave); 154 | AddTile('>', _('Stairs'), $FFBBBB00, teDnStairs, deDrom); 155 | // Water 156 | AddTile('=', _('Water'), $FF333388, teWater, deDark_Wood); 157 | AddTile('=', _('Water'), $FF333377, teWater, deGray_Cave); 158 | AddTile('=', _('Water'), $FF222266, teWater, deDeep_Cave); 159 | AddTile('=', _('Water'), $FF222255, teWater, deBlood_Cave); 160 | AddTile('=', _('Water'), $FF222244, teWater, deDrom); 161 | // Stone Wall 162 | AddTile('#', _('Stone Wall'), $FF818F95, teStoneWall, deDark_Wood); 163 | AddTile('#', _('Stone Wall'), $FF818F95, teStoneWall, deGray_Cave); 164 | AddTile('#', _('Stone Wall'), $FF818F95, teStoneWall, deDeep_Cave); 165 | AddTile('#', _('Stone Wall'), $FF818F95, teStoneWall, deBlood_Cave); 166 | AddTile('#', _('Stone Wall'), $FF818F95, teStoneWall, deDrom); 167 | // _Wooden Wall 168 | AddTile('#', _('Wooden Wall'), $FF776735, teWoodenWall, deDark_Wood); 169 | AddTile('#', _('Wooden Wall'), $FF776735, teWoodenWall, deGray_Cave); 170 | AddTile('#', _('Wooden Wall'), $FF776735, teWoodenWall, deDeep_Cave); 171 | AddTile('#', _('Wooden Wall'), $FF776735, teWoodenWall, deBlood_Cave); 172 | AddTile('#', _('Wooden Wall'), $FF776735, teWoodenWall, deDrom); 173 | // Stone Floor 174 | AddTile('.', _('Stone Floor'), $FF818F95, teStoneFloor, deDark_Wood); 175 | AddTile('.', _('Stone Floor'), $FF818F95, teStoneFloor, deGray_Cave); 176 | AddTile('.', _('Stone Floor'), $FF818F95, teStoneFloor, deDeep_Cave); 177 | AddTile('.', _('Stone Floor'), $FF818F95, teStoneFloor, deBlood_Cave); 178 | AddTile('.', _('Stone Floor'), $FF818F95, teStoneFloor, deDrom); 179 | // _Wooden Floor 180 | AddTile('.', _('Wooden Floor'), $FF776735, teWoodenFloor, deDark_Wood); 181 | AddTile('.', _('Wooden Floor'), $FF776735, teWoodenFloor, deGray_Cave); 182 | AddTile('.', _('Wooden Floor'), $FF776735, teWoodenFloor, deDeep_Cave); 183 | AddTile('.', _('Wooden Floor'), $FF776735, teWoodenFloor, deBlood_Cave); 184 | AddTile('.', _('Wooden Floor'), $FF776735, teWoodenFloor, deDrom); 185 | // Door 186 | AddTile('+', _('Door'), $FF675725, teDoor, deDark_Wood); 187 | AddTile('+', _('Door'), $FF675725, teDoor, deGray_Cave); 188 | AddTile('+', _('Door'), $FF675725, teDoor, deDeep_Cave); 189 | AddTile('+', _('Door'), $FF675725, teDoor, deBlood_Cave); 190 | AddTile('+', _('Door'), $FF675725, teDoor, deDrom); 191 | // Gate 192 | AddTile('+', _('Gate'), $FF515F55, teGate, deDark_Wood); 193 | AddTile('+', _('Gate'), $FF515F55, teGate, deGray_Cave); 194 | AddTile('+', _('Gate'), $FF515F55, teGate, deDeep_Cave); 195 | AddTile('+', _('Gate'), $FF515F55, teGate, deBlood_Cave); 196 | AddTile('+', _('Gate'), $FF515F55, teGate, deDrom); 197 | // Portal 198 | AddTile('O', _('Portal'), $FF9999FF, tePortal, deDark_Wood); 199 | AddTile('O', _('Portal'), $FF9999FF, tePortal, deGray_Cave); 200 | AddTile('O', _('Portal'), $FF9999FF, tePortal, deDeep_Cave); 201 | AddTile('O', _('Portal'), $FF9999FF, tePortal, deBlood_Cave); 202 | AddTile('O', _('Portal'), $FF9999FF, tePortal, deDrom); 203 | // Town Portal 204 | AddTile('O', _('Portal'), $FF9999FF, teTownPortal, deDark_Wood); 205 | AddTile('O', _('Portal'), $FF9999FF, teTownPortal, deGray_Cave); 206 | AddTile('O', _('Portal'), $FF9999FF, teTownPortal, deDeep_Cave); 207 | AddTile('O', _('Portal'), $FF9999FF, teTownPortal, deBlood_Cave); 208 | AddTile('O', _('Portal'), $FF9999FF, teTownPortal, deDrom); 209 | end; 210 | 211 | procedure TMap.AddSpot(AX, AY: UInt; ASize: UInt; AZ: TMapEnum; 212 | ABaseTileEnum, ATileEnum: TTileEnum); 213 | var 214 | Z: TMapEnum; 215 | I, X, Y: UInt; 216 | begin 217 | X := AX; 218 | Y := AY; 219 | Z := AZ; 220 | ASize := Math.EnsureRange(ASize, 49, 9999); 221 | for I := 0 to ASize do 222 | begin 223 | if (Round(Random(6)) = 1) and (X > 0) then 224 | begin 225 | X := X - 1; 226 | if (GetTileEnum(X, Y, Z) <> ABaseTileEnum) then 227 | Continue; 228 | SetTileEnum(X, Y, Z, ATileEnum); 229 | end; 230 | if (Round(Random(6)) = 1) and (X < UIntMax) then 231 | begin 232 | X := X + 1; 233 | if (GetTileEnum(X, Y, Z) <> ABaseTileEnum) then 234 | Continue; 235 | SetTileEnum(X, Y, Z, ATileEnum); 236 | end; 237 | if (Round(Random(6)) = 1) and (Y > 0) then 238 | begin 239 | Y := Y - 1; 240 | if (GetTileEnum(X, Y, Z) <> ABaseTileEnum) then 241 | Continue; 242 | SetTileEnum(X, Y, Z, ATileEnum); 243 | end; 244 | if (Round(Random(6)) = 1) and (Y < UIntMax) then 245 | begin 246 | Y := Y + 1; 247 | if (GetTileEnum(X, Y, Z) <> ABaseTileEnum) then 248 | Continue; 249 | SetTileEnum(X, Y, Z, ATileEnum); 250 | end; 251 | end; 252 | end; 253 | 254 | procedure TMap.AddTile(ASymbol: Char; AName: string; AColor: Cardinal; 255 | ATile: TTileEnum; AZ: TMapEnum); 256 | begin 257 | with Tile[ATile, AZ] do 258 | begin 259 | Symbol := ASymbol; 260 | Name := AName; 261 | Color := AColor; 262 | end; 263 | end; 264 | 265 | procedure TMap.AddTiles(AX, AY: UInt; AZ: TMapEnum; AType: UInt; ADen: UInt; 266 | ABaseTileEnum, ATileEnum: TTileEnum); 267 | var 268 | K, X, Y: UInt; 269 | Z: TMapEnum; 270 | 271 | procedure ModTile(const X, Y: UInt); 272 | begin 273 | if (GetTileEnum(X, Y, Z) = ABaseTileEnum) then 274 | SetTileEnum(X, Y, Z, ATileEnum); 275 | end; 276 | 277 | begin 278 | X := AX; 279 | Y := AY; 280 | Z := AZ; 281 | AType := Math.EnsureRange(AType, 2, 9); 282 | for K := 0 to ADen do 283 | begin 284 | if (Round(Random(AType)) = 1) and (X > 0) then 285 | begin 286 | X := X - 1; 287 | ModTile(X, Y); 288 | end; 289 | if (Round(Random(AType)) = 1) and (X < UIntMax) then 290 | begin 291 | X := X + 1; 292 | ModTile(X, Y); 293 | end; 294 | if (Round(Random(AType)) = 1) and (Y > 0) then 295 | begin 296 | Y := Y - 1; 297 | ModTile(X, Y); 298 | end; 299 | if (Round(Random(AType)) = 1) and (Y < UIntMax) then 300 | begin 301 | Y := Y + 1; 302 | ModTile(X, Y); 303 | end; 304 | end; 305 | end; 306 | 307 | procedure TMap.ClearFOV; 308 | var 309 | X, Y: Int; 310 | Vision: UInt; 311 | begin 312 | Vision := Player.Attributes.Attrib[atVision].Value.InRange(VisionMax); 313 | for Y := Player.Y - Vision to Player.Y + Vision do 314 | for X := Player.X - Vision to Player.X + Vision do 315 | FFOV[Self.EnsureRange(X)][Self.EnsureRange(Y)] := False; 316 | end; 317 | 318 | procedure TMap.Clear(Z: TMapEnum; ATileEnum: TTileEnum); 319 | var 320 | X, Y: UInt; 321 | begin 322 | for Y := 0 to UIntMax do 323 | for X := 0 to UIntMax do 324 | begin 325 | FMap[X][Y][Z] := ATileEnum; 326 | FFog[X][Y][Z] := True; 327 | end; 328 | end; 329 | 330 | constructor TMap.Create; 331 | var 332 | I: TMapEnum; 333 | P: Pointer; 334 | begin 335 | Self.Current := deDark_Wood; 336 | P := TypeInfo(TMapEnum); 337 | for I := Low(TMapEnum) to High(TMapEnum) do 338 | FMapName[I] := GetEnumName(P, Ord(I)).GetName('de'); 339 | end; 340 | 341 | destructor TMap.Destroy; 342 | begin 343 | 344 | inherited; 345 | end; 346 | 347 | function TMap.EnsureRange(Value: Int): UInt; 348 | begin 349 | Result := Value.InRange(UIntMax); 350 | end; 351 | 352 | var 353 | BNPC: array [0 .. 6] of Boolean; 354 | 355 | procedure TMap.Gen; 356 | var 357 | GatePos: TPoint; 358 | I, X, Y: UInt; 359 | Z: TMapEnum; 360 | 361 | const 362 | Pd = 11; 363 | 364 | procedure GenCave(D: UInt; C, V: UInt); 365 | var 366 | I: UInt; 367 | begin 368 | for I := 0 to C do 369 | begin 370 | repeat 371 | X := Math.RandomRange(Pd, UIntMax - Pd); 372 | Y := Math.RandomRange(Pd, UIntMax - Pd); 373 | until (GetTileEnum(X, Y, pred(Z)) = teDefaultFloor); 374 | Self.AddTiles(X, Y, Z, D, V, teDefaultWall, teDefaultFloor); 375 | SetTileEnum(X, Y, pred(Z), teDnStairs); 376 | SetTileEnum(X, Y, Z, teUpStairs); 377 | end; 378 | end; 379 | 380 | procedure AddArea(ADeep: TMapEnum; ABaseTileEnum, ATileEnum: TTileEnum); 381 | var 382 | X, Y: UInt; 383 | begin 384 | repeat 385 | X := Math.RandomRange(Pd, UIntMax - Pd); 386 | Y := Math.RandomRange(Pd, UIntMax - Pd); 387 | until (GetTileEnum(X, Y, ADeep) = ABaseTileEnum); 388 | AddSpot(X, Y, Math.RandomRange(49, UIntMax), ADeep, ABaseTileEnum, 389 | ATileEnum); 390 | end; 391 | 392 | procedure AddFrame(AX, AY, AW, AH: UInt; ABaseTileEnum: TTileEnum); 393 | var 394 | X, Y: UInt; 395 | PX, PY: UInt; 396 | begin 397 | PX := AX - (AW div 2); 398 | PY := AY - (AH div 2); 399 | for X := PX to PX + AW do 400 | for Y := PY to PY + AH do 401 | if not(((X > PX) and (X < (PX + AW))) and ((Y > PY) and (Y < (PY + AH)))) 402 | then 403 | SetTileEnum(X, Y, Z, ABaseTileEnum); 404 | end; 405 | 406 | procedure AddRect(AX, AY, AW, AH: UInt; 407 | AFloorTileEnum, AWallTileEnum: TTileEnum; IsFog: Boolean = False); 408 | var 409 | X, Y: UInt; 410 | PX, PY: UInt; 411 | begin 412 | PX := AX - (AW div 2); 413 | PY := AY - (AH div 2); 414 | for X := PX to PX + AW do 415 | for Y := PY to PY + AH do 416 | begin 417 | if IsFog then 418 | Self.SetFog(X, Y, False); 419 | if (((X > PX) and (X < (PX + AW))) and ((Y > PY) and (Y < (PY + AH)))) 420 | then 421 | SetTileEnum(X, Y, Z, AFloorTileEnum) 422 | else 423 | SetTileEnum(X, Y, Z, AWallTileEnum); 424 | end; 425 | end; 426 | 427 | procedure AddNPC(AX, AY: UInt); 428 | var 429 | I: UInt; 430 | begin 431 | repeat 432 | I := Math.RandomRange(0, 7); 433 | until not BNPC[I]; 434 | Mobs.Add(Self.Current, AX, AY, fcNPC, Ord(mbEldan_2the_magic_trader3) + I); 435 | BNPC[I] := True; 436 | end; 437 | 438 | procedure AddHouse(AX, AY, CX, CY, D: UInt; AV: Boolean; F: Boolean); 439 | var 440 | W, H: UInt; 441 | IsDoor: Boolean; 442 | 443 | procedure AddDoor(X, Y: UInt); 444 | begin 445 | if IsDoor then 446 | Exit; 447 | SetTileEnum(X, Y, Z, teDoor); 448 | IsDoor := True; 449 | AddNPC(AX, AY); 450 | end; 451 | 452 | begin 453 | IsDoor := False; 454 | W := IfThen(AV, 8, RandomRange(2, 5) * 2); 455 | H := IfThen(AV, 8, RandomRange(2, 5) * 2); 456 | AddRect(AX, AY, W, H, teWoodenFloor, teWoodenWall); 457 | // Add door 458 | if AV then 459 | begin 460 | case D of 461 | 4: 462 | AddDoor(AX, AY - (H div 2)); 463 | 5: 464 | AddDoor(AX + (H div 2), AY); 465 | 6: 466 | AddDoor(AX - (H div 2), AY); 467 | 7: 468 | AddDoor(AX, AY + (H div 2)); 469 | end; 470 | Exit; 471 | end; 472 | if F then 473 | if (AX <= CX) then 474 | AddDoor(AX + (W div 2), AY) 475 | else 476 | AddDoor(AX - (W div 2), AY) 477 | else if (AY <= CY) then 478 | AddDoor(AX, AY + (H div 2)) 479 | else 480 | AddDoor(AX, AY - (H div 2)); 481 | end; 482 | 483 | procedure AddVillage(AX, AY: UInt); 484 | var 485 | I, J, T, X, Y, PX, PY: UInt; 486 | HP: array [0 .. 7] of Boolean; 487 | const 488 | House: array [0 .. 7] of TPoint = ((X: - 10; Y: - 10;), (X: 10; Y: - 10; 489 | ), (X: - 10; Y: 10;), (X: 10; Y: 10;), (X: 0; Y: 10;), (X: - 10; Y: 0; 490 | ), (X: 10; Y: 0;), (X: 0; Y: - 10;)); 491 | 492 | procedure AddGate(AX, AY: UInt; SX, SY: ShortInt); 493 | begin 494 | SetTileEnum(AX + SX, AY + SY, Z, teGate); 495 | GatePos := Point(AX + SX, AY + SY); 496 | if (SX = 0) then 497 | begin 498 | SetTileEnum(AX + 1, AY + SY, Z, teGate); 499 | SetTileEnum(AX - 1, AY + SY, Z, teGate); 500 | end; 501 | if (SY = 0) then 502 | begin 503 | SetTileEnum(AX + SX, AY + 1, Z, teGate); 504 | SetTileEnum(AX + SX, AY - 1, Z, teGate); 505 | end; 506 | end; 507 | 508 | begin 509 | // Save to log 510 | Game.Log(Format('Village: %dx%d', [AX, AY])); 511 | Player.X := AX; 512 | Player.Y := AY; 513 | // 514 | AddFrame(AX, AY, 34, 34, teDefaultFloor); 515 | AddRect(AX, AY, 32, 32, teStoneFloor, teStoneWall, True); 516 | for I := 0 to High(House) do 517 | HP[I] := False; 518 | // Add gate 519 | J := Math.RandomRange(4, 8); 520 | case J of 521 | 4: 522 | AddGate(AX, AY, 0, -16); 523 | 5: 524 | AddGate(AX, AY, 16, 0); 525 | 6: 526 | AddGate(AX, AY, -16, 0); 527 | 7: 528 | AddGate(AX, AY, 0, 16); 529 | end; 530 | PX := AX - House[J].X; 531 | PY := AY - House[J].Y; 532 | AddRect(PX, PY, 10, 10, teStoneFloor, teStoneFloor); 533 | HP[J] := True; 534 | // Add houses 535 | T := 0; 536 | while (T < High(House)) do 537 | begin 538 | I := Math.RandomRange(0, 8); 539 | X := AX - House[I].X; 540 | Y := AY - House[I].Y; 541 | if not HP[I] then 542 | begin 543 | AddHouse(X, Y, AX, AY, J, I = (10 - J + 1), (J = 4) or (J = 7)); 544 | HP[I] := True; 545 | Inc(T); 546 | end; 547 | end; 548 | end; 549 | 550 | begin 551 | for I := 0 to 6 do 552 | BNPC[I] := False; 553 | InitTiles(); 554 | for Z := Low(TMapEnum) to High(TMapEnum) do 555 | begin 556 | Self.SetVis(Z, False); 557 | case Z of 558 | deDark_Wood: 559 | begin 560 | Self.SetVis(Z, True); 561 | Self.Clear(Z, teDefaultFloor); 562 | for I := 0 to 9999 do 563 | Self.SetTileEnum(Math.RandomRange(0, UIntMax), 564 | Math.RandomRange(0, UIntMax), Z, teDefaultWall); 565 | Game.Spawn.X := RandomRange(25, UIntMax - 25); 566 | Game.Spawn.Y := RandomRange(25, UIntMax - 25); 567 | Game.Portal.X := Game.Spawn.X; 568 | Game.Portal.Y := Game.Spawn.Y; 569 | AddVillage(Game.Spawn.X, Game.Spawn.Y); 570 | end; 571 | deGray_Cave: 572 | begin 573 | Self.Clear(Z, teDefaultWall); 574 | GenCave(9, 49, 4999); 575 | end; 576 | deDeep_Cave: 577 | begin 578 | Self.Clear(Z, teDefaultWall); 579 | GenCave(6, 39, 3999); 580 | end; 581 | deBlood_Cave: 582 | begin 583 | Self.Clear(Z, teDefaultWall); 584 | GenCave(3, 29, 2999); 585 | end; 586 | deDrom: 587 | begin 588 | Self.Clear(Z, teDefaultWall); 589 | GenCave(2, 19, 1999); 590 | end; 591 | end; 592 | for I := 0 to 9 do 593 | AddArea(Z, teDefaultFloor, teWater); 594 | for I := 0 to 19 do 595 | AddArea(Z, teDefaultFloor, teRock); 596 | for I := 0 to 29 do 597 | AddArea(Z, teDefaultFloor, teFloor1); 598 | for I := 0 to 39 do 599 | AddArea(Z, teDefaultFloor, teFloor2); 600 | for I := 0 to 49 do 601 | AddArea(Z, teDefaultFloor, teFloor3); 602 | end; 603 | 604 | for Z := Low(TMapEnum) to High(TMapEnum) do 605 | begin 606 | // Add mobs 607 | IsBoss := False; 608 | for I := 0 to UIntMax do 609 | Mobs.AddGroup(Z); 610 | end; 611 | end; 612 | 613 | function TMap.GetTile(ATileEnum: TTileEnum): TTile; 614 | begin 615 | Result := Tile[ATileEnum][Current]; 616 | end; 617 | 618 | function TMap.GetTile(AX, AY: UInt): TTile; 619 | begin 620 | Result := Tile[FMap[AX][AY][Current]][Current]; 621 | end; 622 | 623 | function TMap.GetName: string; 624 | begin 625 | if (GetTileEnum(Player.X, Player.Y, Current) in VillageTiles) then 626 | begin 627 | case Current of 628 | deDark_Wood: 629 | Result := _('Village Dork'); 630 | end; 631 | Exit; 632 | end; 633 | Result := _(FMapName[Current]); 634 | end; 635 | 636 | function TMap.GetTileEnum(AX, AY: UInt; AZ: TMapEnum): TTileEnum; 637 | begin 638 | Result := FMap[AX][AY][AZ]; 639 | end; 640 | 641 | function TMap.GetVis(const AZ: TMapEnum): Boolean; 642 | begin 643 | Result := FVis[AZ]; 644 | end; 645 | 646 | procedure TMap.SetTileEnum(AX, AY: UInt; AZ: TMapEnum; ATileEnum: TTileEnum); 647 | begin 648 | FMap[AX][AY][AZ] := ATileEnum; 649 | end; 650 | 651 | function TMap.GetFog(AX, AY: UInt): Boolean; 652 | begin 653 | Result := FFog[AX][AY][Current]; 654 | end; 655 | 656 | procedure TMap.SetFog(AX, AY: UInt; AFlag: Boolean); 657 | begin 658 | FFog[AX][AY][Current] := AFlag; 659 | end; 660 | 661 | function TMap.InMap(AX, AY: Int): Boolean; 662 | begin 663 | Result := (AX >= 0) and (AY >= 0) and (AX <= UIntMax) and (AY <= UIntMax) 664 | end; 665 | 666 | function TMap.InView(AX, AY: Int): Boolean; 667 | var 668 | PX, PY: Int; 669 | begin 670 | PX := View.Width div 2; 671 | PY := View.Height div 2; 672 | Result := (AX >= Player.X - PX) and (AY >= Player.Y - PY) and 673 | (AX <= Player.X + PX - 1) and (AY <= Player.Y + PY - 1); 674 | end; 675 | 676 | function TMap.GetFOV(AX, AY: UInt): Boolean; 677 | begin 678 | Result := FFOV[AX][AY]; 679 | end; 680 | 681 | procedure TMap.SetFOV(AX, AY: UInt; AFlag: Boolean); 682 | begin 683 | FFOV[AX][AY] := AFlag; 684 | end; 685 | 686 | procedure TMap.SetVis(const AZ: TMapEnum; const Value: Boolean); 687 | begin 688 | FVis[AZ] := Value; 689 | end; 690 | 691 | initialization 692 | 693 | Map := TMap.Create; 694 | 695 | finalization 696 | 697 | FreeAndNil(Map); 698 | 699 | end. 700 | --------------------------------------------------------------------------------