├── .gitignore ├── .travis.yml ├── 3rd_party ├── glext40.pas ├── opengl │ ├── topenglcontrol.xpm │ ├── vcmi.glcarbonaglcontext.pas │ ├── vcmi.glcocoanscontext.pas │ ├── vcmi.glext.pp │ ├── vcmi.glgtkglxcontext.pas │ ├── vcmi.glqtcontext.pas │ ├── vcmi.glwin32wglcontext.pas │ ├── vcmi.openglcontext.pas │ ├── vcmi.wgl.pas │ ├── vcmiopenglcontext.lpk │ ├── vcmiopenglcontext.pas │ ├── vcmiopenglcontext.rc │ └── vcmiopenglcontext.res ├── vcmi_csvdocument.pp ├── vcmi_csvreadwrite.pp └── vcmi_fpjsonrtti.pas ├── COPYING ├── COPYING.LGPL.txt ├── COPYING.modifiedLGPL.txt ├── Makefile ├── base_info.pas ├── compilersetup.inc ├── editor_classes.pas ├── editor_consts.pas ├── editor_gl.pas ├── editor_graphics.pas ├── editor_rtti.pas ├── editor_str_consts.pas ├── editor_types.pas ├── editor_utils.pas ├── extrafpc.cfg ├── field_editors.pas ├── filesystem.pas ├── filesystem_base.pas ├── forms ├── abandoned_frame.lfm ├── abandoned_frame.pas ├── base_options_frame.lfm ├── base_options_frame.pas ├── creature_frame.lfm ├── creature_frame.pas ├── creature_set_frame.lfm ├── creature_set_frame.pas ├── dwelling_frame.lfm ├── dwelling_frame.pas ├── edit_hero_options.lfm ├── edit_hero_options.pas ├── edit_map_options.lfm ├── edit_map_options.pas ├── edit_object_options.lfm ├── edit_object_options.pas ├── edit_triggered_events.lfm ├── edit_triggered_events.pas ├── flaggable_object_frame.lfm ├── flaggable_object_frame.pas ├── grail_frame.lfm ├── grail_frame.pas ├── gui_helpers.pas ├── hero_artifacts_frame.lfm ├── hero_artifacts_frame.pas ├── hero_frame.lfm ├── hero_frame.pas ├── hero_skills_frame.lfm ├── hero_skills_frame.pas ├── hero_spells_frame.lfm ├── hero_spells_frame.pas ├── local_event_frame.lfm ├── local_event_frame.pas ├── message_frame.lfm ├── message_frame.pas ├── new_map.lfm ├── new_map.pas ├── player_options_form.lfm ├── player_options_form.pas ├── player_options_frame.lfm ├── player_options_frame.pas ├── player_selection_form.lfm ├── player_selection_form.pas ├── position.pas ├── quest_frame.lfm ├── quest_frame.pas ├── resource_frame.lfm ├── resource_frame.pas ├── reward_frame.lfm ├── reward_frame.pas ├── scholar_frame.lfm ├── scholar_frame.pas ├── shrine_frame.lfm ├── shrine_frame.pas ├── spellscroll_frame.lfm ├── spellscroll_frame.pas ├── subframes │ ├── object_link_frame.lfm │ ├── object_link_frame.pas │ ├── triggered_event_frame.lfm │ └── triggered_event_frame.pas ├── town_buildings_frame.lfm ├── town_buildings_frame.pas ├── town_frame.lfm ├── town_frame.pas ├── town_spells_frame.lfm ├── town_spells_frame.pas ├── witchhut_frame.lfm └── witchhut_frame.pas ├── h3_txt.pas ├── lists_manager.pas ├── locale_manager.pas ├── lod.pas ├── logical_building_condition.pas ├── logical_event_condition.pas ├── logical_expression.pas ├── logical_id_condition.pas ├── main.lfm ├── main.pas ├── map.pas ├── map_actions.pas ├── map_erase_actions.pas ├── map_format.pas ├── map_format_h3m.pas ├── map_format_json.pas ├── map_format_zip.pas ├── map_object_actions.pas ├── map_objects.pas ├── map_rect.pas ├── map_road_river_actions.pas ├── map_terrain_actions.pas ├── minimap.pas ├── object_options.pas ├── progress_form.lfm ├── progress_form.pas ├── road_transitions.pas ├── root_manager.lfm ├── root_manager.pas ├── search_index.pas ├── shaders ├── default_f.glsl └── default_v.glsl ├── stream_adapter.pas ├── terrain.pas ├── tests ├── test_csvdocunent.pas ├── unit_tests.lpi └── unit_tests.lpr ├── transitions.pas ├── undo_base.pas ├── undo_map.pas ├── vcmi.dirs.base.pas ├── vcmi.dirs.windows.pas ├── vcmi.dirs.xdg.pas ├── vcmi.frames.tools.lfm ├── vcmi.frames.tools.pas ├── vcmi.image_formats.h3pcx.pas ├── vcmi.image_loaders.pas ├── vcmi.lpg ├── vcmi_json.pas ├── vcmieditor.ico ├── vcmieditor.lpi ├── vcmieditor.lpr ├── zipper_ex.pas └── zlib_stream.pas /.gitignore: -------------------------------------------------------------------------------- 1 | *.lps 2 | *.compiled 3 | *.o 4 | *.a 5 | *.ppu 6 | *.bak 7 | *.swp 8 | *.lrt 9 | 10 | /bin 11 | /bin64 12 | /units 13 | 14 | heap.trc 15 | 16 | /tests/unit_tests 17 | /tests/*.exe 18 | /vcmieditor.res 19 | /3rd_party/opengl/lib/* 20 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: xenial 2 | 3 | language: generic 4 | 5 | addons: 6 | apt: 7 | update: true 8 | packages: 9 | - libgtk2.0-dev 10 | - libgl1-mesa-dev 11 | 12 | before_install: 13 | - wget -t 10 -O lazarus-project_2.0.0-0_amd64.deb https://sourceforge.net/projects/lazarus/files/Lazarus%20Linux%20amd64%20DEB/Lazarus%202.0.0/lazarus-project_2.0.0-0_amd64.deb/download 14 | - wget -t 10 -O fpc-laz_3.0.4-1_amd64.deb https://sourceforge.net/projects/lazarus/files/Lazarus%20Linux%20amd64%20DEB/Lazarus%202.0.0/fpc-laz_3.0.4-1_amd64.deb/download 15 | - wget -t 10 -O fpc-src_3.0.4-2_amd64.deb https://sourceforge.net/projects/lazarus/files/Lazarus%20Linux%20amd64%20DEB/Lazarus%202.0.0/fpc-src_3.0.4-2_amd64.deb/download 16 | - sudo dpkg -i fpc-src_3.0.4-2_amd64.deb fpc-laz_3.0.4-1_amd64.deb lazarus-project_2.0.0-0_amd64.deb 17 | 18 | script: 19 | - make 20 | - make test 21 | 22 | notifications: 23 | slack: 24 | secure: PCe/rd18XEEH3Pq6ugftgz8+lqWn4XOGc6QbNcax5virYuWaYaEEq9Sq3K0HqdEYyLrWV8r3hcEcZd43zsHkeqIZKsT7ieQzaT2r9HoEGeU4xX7WJmj9rZUnpZuY7aD6qa6/1x5XgwDeBYEeKc87HWEuiJeo9NKOmYMtKvPwxzc= 25 | -------------------------------------------------------------------------------- /3rd_party/opengl/topenglcontrol.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tgtkglareacontrol_xpm[] = { 3 | "18 21 187 2", 4 | " c None", 5 | ". c #C2DAFE", 6 | "+ c #BECEFE", 7 | "@ c #B2C2FE", 8 | "# c #B6CAFE", 9 | "$ c #AABAFE", 10 | "% c #A2AEFE", 11 | "& c #96A2FE", 12 | "* c #A2B2FE", 13 | "= c #929EFE", 14 | "- c #8E92FE", 15 | "; c #868AFE", 16 | "> c #8A82FE", 17 | ", c #62AAFE", 18 | "' c #7EAAFA", 19 | ") c #A6BEFA", 20 | "! c #AEBEFE", 21 | "~ c #9AA2FE", 22 | "{ c #9296FE", 23 | "] c #7E86F6", 24 | "^ c #3E66DE", 25 | "/ c #064ABA", 26 | "( c #66AAFE", 27 | "_ c #5E96F6", 28 | ": c #5A92F6", 29 | "< c #7E9AF6", 30 | "[ c #92A2FA", 31 | "} c #7E92FA", 32 | "| c #4E76E6", 33 | "1 c #1252C6", 34 | "2 c #0246B2", 35 | "3 c #06429E", 36 | "4 c #66A2FA", 37 | "5 c #5E8AEE", 38 | "6 c #5A8EEE", 39 | "7 c #527EE6", 40 | "8 c #527AE6", 41 | "9 c #2262E6", 42 | "0 c #0252CE", 43 | "a c #024ABA", 44 | "b c #0642A6", 45 | "c c #0A4296", 46 | "d c #5286FA", 47 | "e c #527AE2", 48 | "f c #5276DA", 49 | "g c #4272E2", 50 | "h c #0A5ADE", 51 | "i c #024EBE", 52 | "j c #0246AA", 53 | "k c #063A92", 54 | "l c #06367E", 55 | "m c #FEDADA", 56 | "n c #FACECE", 57 | "o c #3E76EE", 58 | "p c #5272DA", 59 | "q c #4E6ED6", 60 | "r c #3A5AC6", 61 | "s c #0A4EC2", 62 | "t c #0646AA", 63 | "u c #063E92", 64 | "v c #06327A", 65 | "w c #062E72", 66 | "x c #FEC2C2", 67 | "y c #F6B6B6", 68 | "z c #3266DE", 69 | "A c #4A66CE", 70 | "B c #4A62CA", 71 | "C c #0A46AE", 72 | "D c #063686", 73 | "E c #062E6A", 74 | "F c #0A2656", 75 | "G c #FEB6B6", 76 | "H c #F6A6AA", 77 | "I c #4662CE", 78 | "J c #425ACA", 79 | "K c #3E52C2", 80 | "L c #324EB6", 81 | "M c #0A3272", 82 | "N c #12223E", 83 | "O c #FE6666", 84 | "P c #FE8686", 85 | "Q c #FEAAAA", 86 | "R c #FEAEB2", 87 | "S c #FEA6A2", 88 | "T c #E67E7E", 89 | "U c #864666", 90 | "V c #4A4EAA", 91 | "W c #3E4ABA", 92 | "X c #2E42AA", 93 | "Y c #0A368A", 94 | "Z c #0E2652", 95 | "` c #223E46", 96 | " . c #5A6E26", 97 | ".. c #FA4E4E", 98 | "+. c #F64646", 99 | "@. c #F64A4A", 100 | "#. c #F66E72", 101 | "$. c #F28A86", 102 | "%. c #DA6E6E", 103 | "&. c #862626", 104 | "*. c #461206", 105 | "=. c #3A529A", 106 | "-. c #0A2E6E", 107 | ";. c #425A32", 108 | ">. c #5E8222", 109 | ",. c #5E9626", 110 | "'. c #629622", 111 | "). c #F24242", 112 | "!. c #EE3E3E", 113 | "~. c #EE3A3A", 114 | "{. c #E63232", 115 | "]. c #9E0A0A", 116 | "^. c #6A0202", 117 | "/. c #72DE3E", 118 | "(. c #96EE6A", 119 | "_. c #5ADA26", 120 | ":. c #6EB23E", 121 | "<. c #6ABA3E", 122 | "[. c #66BA3E", 123 | "}. c #5EBE32", 124 | "|. c #4AA21E", 125 | "1. c #367A0E", 126 | "2. c #EE4242", 127 | "3. c #E63636", 128 | "4. c #A60606", 129 | "5. c #7A0206", 130 | "6. c #3ECE02", 131 | "7. c #3ECA0A", 132 | "8. c #76E64A", 133 | "9. c #8AFE62", 134 | "0. c #76FA4E", 135 | "a. c #62DA3A", 136 | "b. c #329616", 137 | "c. c #1E6E06", 138 | "d. c #1A6206", 139 | "e. c #E63632", 140 | "f. c #E62E2E", 141 | "g. c #E22626", 142 | "h. c #960206", 143 | "i. c #6E0206", 144 | "j. c #3EC606", 145 | "k. c #3AC606", 146 | "l. c #36BA02", 147 | "m. c #32B602", 148 | "n. c #4EC226", 149 | "o. c #36961E", 150 | "p. c #1E7206", 151 | "q. c #1A6202", 152 | "r. c #165E02", 153 | "s. c #1A5A06", 154 | "t. c #EA3636", 155 | "u. c #E22E2E", 156 | "v. c #DE2A2A", 157 | "w. c #D61E1E", 158 | "x. c #820202", 159 | "y. c #560206", 160 | "z. c #36B606", 161 | "A. c #32AE06", 162 | "B. c #2EA206", 163 | "C. c #1E6606", 164 | "D. c #1A5E06", 165 | "E. c #165606", 166 | "F. c #164E06", 167 | "G. c #420206", 168 | "H. c #32AA06", 169 | "I. c #2EA606", 170 | "J. c #269606", 171 | "K. c #124606", 172 | "L. c #5E0206", 173 | "M. c #2AA206", 174 | "N. c #2A9E06", 175 | "O. c #268E06", 176 | "P. c #165206", 177 | "Q. c #164A06", 178 | "R. c #123E06", 179 | "S. c #2AA606", 180 | "T. c #2A9A06", 181 | "U. c #228606", 182 | "V. c #124E06", 183 | "W. c #124206", 184 | "X. c #0E3A06", 185 | "Y. c #123606", 186 | "Z. c #228A06", 187 | "`. c #1A7A06", 188 | " + c #0E3E06", 189 | ".+ c #1A6E06", 190 | "++ c #0E3606", 191 | " . + ", 192 | " @ @ # $ % & ", 193 | " @ @ @ @ @ * = - ; > ", 194 | " , ' ) ! % ~ { ] ^ / ", 195 | " ( _ : < [ } | 1 2 3 ", 196 | " 4 5 6 7 8 9 0 a b c ", 197 | " d 7 e f g h i j k l ", 198 | " m n o f p q r s t u v w ", 199 | " x x x y z q A B r C k D E F ", 200 | "x x x x G H I B J K L c v M F N ", 201 | "O P Q G R S T U V W X Y w Z ` . ", 202 | "..+.@.#.$.%.&.*.*.*.=.-.` ;. .>.,.'.", 203 | "@.).!.~.{.].^.*./.(._.:.:.<.[.}.|.1.", 204 | "2.!.3.3.{.4.5.*.6.7._.8.9.0.a.b.c.d.", 205 | "!.e.{.f.g.h.i.*.j.k.l.m.n.o.p.q.r.s.", 206 | "t.u.v.g.w.x.y.*.l.z.z.A.B.r.C.D.E.F.", 207 | " w.w.w.i.G.*.z.H.I.I.J.D.D.E.F.K.", 208 | " w.L. H.I.M.N.O.E.P.Q.K.R.", 209 | " S.T.J.O.U.Q.V.W.X.Y.", 210 | " Z.Z.`.W. +X. ", 211 | " .+++ "}; 212 | -------------------------------------------------------------------------------- /3rd_party/opengl/vcmiopenglcontext.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | -------------------------------------------------------------------------------- /3rd_party/opengl/vcmiopenglcontext.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit vcmiOpenGLContext; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | vcmi.openglcontext, vcmi.glext; 12 | 13 | implementation 14 | 15 | end. 16 | -------------------------------------------------------------------------------- /3rd_party/opengl/vcmiopenglcontext.rc: -------------------------------------------------------------------------------- 1 | TOPNEGLCONTROL RCDATA "topenglcontrol.xpm" -------------------------------------------------------------------------------- /3rd_party/opengl/vcmiopenglcontext.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vcmi/vcmi_editor/41eeeeb64e7b885b8076750d96634dbda96ac6b6/3rd_party/opengl/vcmiopenglcontext.res -------------------------------------------------------------------------------- /COPYING.modifiedLGPL.txt: -------------------------------------------------------------------------------- 1 | This is the file COPYING.modifiedLGPL, it applies to several units in the 2 | Lazarus sources distributed by members of the Lazarus Development Team. 3 | All files contains headers showing the appropriate license. See there if this 4 | modification can be applied. 5 | 6 | These files are distributed under the Library GNU General Public License 7 | (see the file COPYING.LGPL) with the following modification: 8 | 9 | As a special exception, the copyright holders of this library give you 10 | permission to link this library with independent modules to produce an 11 | executable, regardless of the license terms of these independent modules, 12 | and to copy and distribute the resulting executable under terms of your choice, 13 | provided that you also meet, for each linked independent module, the terms 14 | and conditions of the license of that module. An independent module is a 15 | module which is not derived from or based on this library. If you modify this 16 | library, you may extend this exception to your version of the library, but 17 | you are not obligated to do so. If you do not wish to do so, delete this 18 | exception statement from your version. 19 | 20 | 21 | If you didn't receive a copy of the file COPYING.LGPL, contact: 22 | Free Software Foundation, Inc., 23 | 675 Mass Ave 24 | Cambridge, MA 02139 25 | USA 26 | 27 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: vcmieditor 2 | 3 | vcmieditor: 4 | lazbuild --bm=RD 3rd_party/opengl/vcmiopenglcontext.lpk vcmieditor.lpr 5 | 6 | build_tests: 7 | lazbuild tests/unit_tests.lpr 8 | 9 | test: build_tests 10 | ./tests/unit_tests --all --progress --format=plain 11 | 12 | clean_tests: 13 | rm -rf tests/unit_tests tests/*.o tests/*.ppu tests/*.compiled 14 | 15 | clean: clean_tests 16 | rm -rf vcmieditor *.o *.ppu *.compiled 17 | -------------------------------------------------------------------------------- /base_info.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit base_info; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, fpjson, editor_types, editor_classes; 25 | 26 | type 27 | {$push} 28 | {$m+} 29 | 30 | { TBaseInfo } 31 | 32 | TBaseInfo = class abstract(TNamedCollectionItem) 33 | private 34 | FName: TLocalizedString; 35 | FIndex: TCustomID; 36 | 37 | function GetCollectionIndex: integer; 38 | procedure SetCollectionIndex(AValue: integer); 39 | 40 | procedure SetIndex_(AValue: TCustomID); 41 | protected 42 | function GetName: TLocalizedString; virtual; 43 | procedure SetName(const AValue: TLocalizedString); virtual; 44 | public 45 | constructor Create(ACollection: TCollection); override; 46 | 47 | property CollectionIndex: integer read GetCollectionIndex write SetCollectionIndex; 48 | 49 | function IsValid: Boolean; virtual; 50 | published 51 | property Name: TLocalizedString read GetName write SetName; 52 | property Index: TCustomID read FIndex write SetIndex_ default ID_INVALID; 53 | end; 54 | 55 | { TMapObjectInfo } 56 | 57 | TMapObjectInfo = class abstract (TBaseInfo) 58 | private 59 | FMapObject: TJSONObject; 60 | public 61 | constructor Create(ACollection: TCollection); override; 62 | destructor Destroy; override; 63 | published 64 | property MapObject: TJSONObject read FMapObject; 65 | end; 66 | 67 | {$pop} 68 | 69 | implementation 70 | 71 | { TMapObjectInfo } 72 | 73 | constructor TMapObjectInfo.Create(ACollection: TCollection); 74 | begin 75 | inherited Create(ACollection); 76 | FMapObject := CreateJSONObject([]); 77 | end; 78 | 79 | destructor TMapObjectInfo.Destroy; 80 | begin 81 | FMapObject.Free; 82 | inherited Destroy; 83 | end; 84 | 85 | { TBaseInfo } 86 | 87 | constructor TBaseInfo.Create(ACollection: TCollection); 88 | begin 89 | inherited Create(ACollection); 90 | FIndex := ID_INVALID; 91 | end; 92 | 93 | function TBaseInfo.IsValid: Boolean; 94 | begin 95 | Result := true; 96 | end; 97 | 98 | function TBaseInfo.GetCollectionIndex: integer; 99 | begin 100 | Result := inherited Index; 101 | end; 102 | 103 | procedure TBaseInfo.SetCollectionIndex(AValue: integer); 104 | begin 105 | inherited Index := AValue; 106 | end; 107 | 108 | function TBaseInfo.GetName: TLocalizedString; 109 | begin 110 | if FName = '' then 111 | begin 112 | Result := Identifier; 113 | end 114 | else 115 | begin 116 | Result := FName; 117 | end; 118 | end; 119 | 120 | procedure TBaseInfo.SetName(const AValue: TLocalizedString); 121 | begin 122 | FName := AValue; 123 | end; 124 | 125 | procedure TBaseInfo.SetIndex_(AValue: TCustomID); 126 | begin 127 | if FIndex = AValue then Exit; 128 | FIndex := AValue; 129 | end; 130 | 131 | end. 132 | 133 | -------------------------------------------------------------------------------- /compilersetup.inc: -------------------------------------------------------------------------------- 1 | {$IF FPC_FULLVERSION < 30000} 2 | {$ERROR Freepascal 3.0.0 + required} 3 | {$ENDIF} 4 | 5 | {$mode objfpc} 6 | {$modeswitch advancedrecords} 7 | {$MODESWITCH NESTEDPROCVARS} 8 | {$H+} 9 | {$SCOPEDENUMS ON} 10 | {$INLINE ON} 11 | 12 | {$ifdef ENDIAN_BIG} 13 | {$warning big-endian is untested} 14 | {$endif} 15 | -------------------------------------------------------------------------------- /editor_rtti.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit editor_rtti; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, typinfo; 25 | 26 | 27 | function IsDefaultValue(AObject: TObject; APropName: String): Boolean; 28 | 29 | function IsDefaultValue(AObject: TObject; PropertyInfo: PPropInfo): Boolean; 30 | 31 | 32 | implementation 33 | 34 | function IsDefaultValue(AObject: TObject; APropName: String): Boolean; 35 | begin 36 | Result := IsDefaultValue(AObject, GetPropInfo(AObject,APropName)); 37 | end; 38 | 39 | function IsDefaultValue(AObject: TObject; PropertyInfo: PPropInfo): Boolean; 40 | var 41 | PropType: PTypeInfo; 42 | Value: Int64; 43 | DefValue: Int64; 44 | SValue: String; 45 | begin 46 | PropType := PropertyInfo^.PropType; 47 | 48 | case PropType^.Kind of 49 | tkInteger, tkInt64, tkChar, tkEnumeration, tkWChar,tkSet, tkBool, tkQWord: begin 50 | Value := GetOrdProp(AObject, PropertyInfo); 51 | DefValue := PropertyInfo^.Default; 52 | 53 | if (Value = DefValue) and (DefValue<>longint($80000000)) then 54 | begin 55 | Exit(True); 56 | end; 57 | end; 58 | tkString, tkAString:begin 59 | SValue := GetStrProp(AObject, PropertyInfo); 60 | if SValue = '' then 61 | begin 62 | Exit(True); 63 | end; 64 | end; 65 | end; 66 | 67 | Result := False; 68 | end; 69 | 70 | end. 71 | 72 | -------------------------------------------------------------------------------- /editor_str_consts.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit editor_str_consts; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | resourcestring 25 | rsDefaultMapName = 'Untitled'; 26 | 27 | rsConfirm = 'Confirm'; 28 | rsFileExists = 'File already exists. Replase?'; 29 | 30 | rsMapChanged = 'Map has been changed. Save?'; 31 | 32 | rsRedo = 'Redo'; 33 | rsUndo = 'Undo'; 34 | 35 | rsRoadTypeNone = 'Delete'; 36 | rsRoadTypeDirt = 'Dirt'; 37 | rsRoadTypeGravel= 'Gravel'; 38 | rsRoadTypeCobblestone = 'Cobblestone'; 39 | 40 | rsRiverTypeNone = 'Delete'; 41 | rsRiverTypeClear = 'Water'; 42 | rsRiverTypeIcy = 'Ice'; 43 | rsRiverTypeMuddy = 'Muddy'; 44 | rsRiverTypeLava = 'Lava'; 45 | 46 | rsEditTerrainDescription = 'Edit terrain'; 47 | rsEditRoadDescription = 'Edit roads'; 48 | rsEditRiverDescription = 'Edit rivers'; 49 | 50 | rsEraseDescription = 'Filtered erase'; 51 | 52 | rsEmpty = '(Empty)'; 53 | rsNone = '(None)'; 54 | 55 | rsArmy = 'Army'; 56 | rsGuards = 'Guards'; 57 | 58 | rsSlotHead = 'Head'; 59 | rsSlotShoulders = 'Shoulders'; 60 | rsSlotNeck = 'Neck'; 61 | rsSlotRightHand = 'RightHand'; 62 | rsSlotLeftHand = 'LeftHand'; 63 | rsSlotTorso = 'Torso'; 64 | rsSlotRightRing = 'RightRing'; 65 | rsSlotLeftRing = 'LeftRing'; 66 | 67 | rsSlotFeet = 'Feet'; 68 | rsSlotMisc1 = 'Misc1'; 69 | rsSlotMisc2 = 'Misc2'; 70 | rsSlotMisc3 = 'Misc3'; 71 | rsSlotMisc4 = 'Misc4'; 72 | rsSlotMisc5 = 'Misc5'; 73 | rsSlotMach1 = 'Mach1'; 74 | rsSlotMach2 = 'Mach2'; 75 | 76 | rsSlotMach3 = 'Mach3'; 77 | rsSlotMach4 = 'Mach4'; 78 | rsSlotSpellbook = 'Spellbook'; 79 | 80 | rsSlotBackpack = 'Backpack'; 81 | 82 | rsRandomCreatureName = 'Creature of level %d'; 83 | rsRandomCreatureNameUpgrade = 'Upgraded creature of level %d'; 84 | 85 | rsAddObjectDescription = 'Add object'; 86 | rsCopyObjectDescription = 'Copy object'; 87 | rsDeleteObjectDescription = 'Delete object'; 88 | rsDeleteObjectsDescription = 'Delete objects'; 89 | rsEditObjectDescription = 'Edit object'; 90 | rsMoveObjectDescription = 'Move object'; 91 | 92 | rsAllSpells = 'All spells'; 93 | rsSpellsOfLevel = 'Spells of level %d'; 94 | 95 | rsTabMainOptions = 'Main options'; 96 | rsTabSpecificOptions = 'Specific options'; 97 | rsTabSecondarySkills = 'Secondary skills'; 98 | rsTabArtifacts = 'Artifacts'; 99 | rsTabSpells = 'Spells'; 100 | rsTabQuest = 'Quest'; 101 | rsTabRewards = 'Reward'; 102 | rsTabBuildings = 'Buildings'; 103 | 104 | rsEraseFilterRivers = 'Rivers'; 105 | rsEraseFilterRoads = 'Roads'; 106 | rsEraseFilterStatic = 'Static objects'; 107 | rsEraseFilterInteractive = 'Interactive objects'; 108 | 109 | rsEraseObjectBBox = 'Bounding box'; 110 | rsEraseObjectVisibleMask = 'Visible mask'; 111 | rsEraseObjectBlockMask = 'Block mask'; 112 | rsEraseObjectVisitableMask = 'Visitable mask'; 113 | 114 | implementation 115 | 116 | end. 117 | 118 | -------------------------------------------------------------------------------- /extrafpc.cfg: -------------------------------------------------------------------------------- 1 | # --------------- 2 | # Code generation 3 | # --------------- 4 | 5 | # Uncomment the next line if you always want static/dynamic units by default 6 | # (can be overruled with -CD, -CS at the commandline) 7 | #-CS 8 | #-CD 9 | 10 | # Set the default heapsize to 8Mb 11 | #-Ch8000000 12 | 13 | # Set default codegeneration checks (iocheck, overflow, range, stack) 14 | #-Ci 15 | #-Co 16 | #-Cr 17 | #-Ct 18 | 19 | # Optimizer switches 20 | # -Os generate smaller code 21 | # -Oa=N set alignment to N 22 | # -O1 level 1 optimizations (quick optimizations, debuggable) 23 | # -O2 level 2 optimizations (-O1 + optimizations which make debugging more difficult) 24 | # -O3 level 3 optimizations (-O2 + optimizations which also may make the program slower rather than faster) 25 | # -Oo switch on optimalization x. See fpc -i for possible values 26 | # -OoNO switch off optimalization x. See fpc -i for possible values 27 | # -Op set target cpu for optimizing, see fpc -i for possible values 28 | 29 | 30 | # ------------- 31 | # Linking 32 | # ------------- 33 | 34 | # generate always debugging information for GDB (slows down the compiling 35 | # process) 36 | # -gc generate checks for pointers 37 | # -gd use dbx 38 | # -gg use gsym 39 | # -gh use heap trace unit (for memory leak debugging) 40 | # -gl use line info unit to show more info for backtraces 41 | # -gv generates programs tracable with valgrind 42 | # -gw generate dwarf debugging info 43 | # 44 | # Enable debuginfo and use the line info unit by default 45 | #-gl 46 | 47 | # always pass an option to the linker 48 | #-k-s 49 | 50 | # Always strip debuginfo from the executable 51 | -Xs -------------------------------------------------------------------------------- /filesystem_base.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit filesystem_base; 19 | 20 | {$I compilersetup.inc} 21 | {$INTERFACES CORBA} 22 | 23 | interface 24 | 25 | uses 26 | Classes, SysUtils, Types; 27 | 28 | type 29 | 30 | TResourceType = (Text, Json, Animation, Mask, Image); 31 | 32 | TResourceTypes = set of TResourceType; 33 | 34 | IResource = interface 35 | procedure LoadFromStream(AFileName: AnsiString; AStream: TStream); 36 | end; 37 | 38 | { TResourceLoader } 39 | 40 | IResourceLoader = interface ['{6BBEC2EA-75F4-4836-B25B-2F68B25091F2}'] 41 | (* 42 | AResource - resource object to load 43 | AResType - type of resourse 44 | AName - relative path + filename .w\o ext 45 | *) 46 | procedure LoadResource(AResource: IResource; AResType: TResourceType; AName: string); 47 | 48 | procedure LoadResourceCombined(AResource: IResource; AResType: TResourceType; AName: string); 49 | 50 | function ExistsResource(AResType: TResourceType; AName: string): boolean; 51 | 52 | function TryLoadResource(AResource: IResource; AResType: TResourceType; AName: string):boolean; 53 | 54 | function GetModDepenencies(AModId: AnsiString): TStringDynArray; 55 | 56 | function GetEnabledMods: TStringDynArray; 57 | end; 58 | 59 | { TBaseResource } 60 | 61 | TBaseResource = class abstract (TObject, IResource) 62 | private 63 | FPath: AnsiString; 64 | FTyp: TResourceType; 65 | public 66 | constructor Create(AType: TResourceType; APath: AnsiString); 67 | property Typ: TResourceType read FTyp; 68 | property Path: AnsiString read FPath; 69 | 70 | procedure LoadFromStream(AFileName: AnsiString; AStream: TStream); virtual; abstract; 71 | 72 | procedure Load(ALoader: IResourceLoader); virtual; 73 | function TryLoad(ALoader: IResourceLoader): Boolean; virtual; 74 | end; 75 | 76 | { TFSConsumer } 77 | 78 | TFSConsumer = class abstract (TComponent) 79 | private 80 | FResourceLoader: IResourceLoader; 81 | public 82 | constructor Create(AOwner: TComponent); override; 83 | property ResourceLoader:IResourceLoader read FResourceLoader; 84 | end; 85 | 86 | implementation 87 | 88 | { TBaseResource } 89 | 90 | constructor TBaseResource.Create(AType: TResourceType; APath: AnsiString); 91 | begin 92 | FTyp:=AType; 93 | FPath:=APath; 94 | end; 95 | 96 | procedure TBaseResource.Load(ALoader: IResourceLoader); 97 | begin 98 | ALoader.LoadResource(Self, Typ, Path); 99 | end; 100 | 101 | function TBaseResource.TryLoad(ALoader: IResourceLoader): Boolean; 102 | begin 103 | Result := ALoader.TryLoadResource(Self, Typ, Path); 104 | end; 105 | 106 | 107 | { TFSConsumer } 108 | 109 | constructor TFSConsumer.Create(AOwner: TComponent); 110 | var 111 | rl: IResourceLoader; 112 | begin 113 | inherited Create(AOwner); 114 | 115 | if AOwner.GetInterface(IResourceLoader,rl) then 116 | begin 117 | FResourceLoader := rl; 118 | end 119 | else 120 | if AOwner is TFSConsumer then 121 | begin 122 | FResourceLoader := (AOwner as TFSConsumer).ResourceLoader; 123 | end; 124 | end; 125 | 126 | 127 | end. 128 | 129 | -------------------------------------------------------------------------------- /forms/abandoned_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited AbandonedFrame: TAbandonedFrame 2 | Height = 243 3 | Width = 319 4 | ClientHeight = 243 5 | ClientWidth = 319 6 | DesignLeft = 587 7 | DesignTop = 267 8 | object PossibleResourcesLabel: TLabel[0] 9 | Left = 8 10 | Height = 15 11 | Top = 8 12 | Width = 99 13 | Caption = 'Possible resources:' 14 | ParentColor = False 15 | end 16 | object edPossibleResources: TCheckListBox[1] 17 | Left = 8 18 | Height = 200 19 | Top = 32 20 | Width = 300 21 | Anchors = [akTop, akLeft, akRight, akBottom] 22 | ItemHeight = 0 23 | TabOrder = 0 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /forms/abandoned_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA.. 16 | } 17 | 18 | unit abandoned_frame; 19 | 20 | {$mode objfpc}{$H+} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 26 | CheckLst, base_options_frame, editor_types, object_options, 27 | editor_consts; 28 | 29 | type 30 | 31 | { TAbandonedFrame } 32 | 33 | TAbandonedFrame = class(TBaseOptionsFrame) 34 | edPossibleResources: TCheckListBox; 35 | PossibleResourcesLabel: TLabel; 36 | private 37 | FOptions: TAbandonedOptions; 38 | public 39 | procedure Commit; override; 40 | procedure VisitAbandonedMine(AOptions: TAbandonedOptions); override; 41 | end; 42 | 43 | implementation 44 | 45 | {$R *.lfm} 46 | 47 | { TAbandonedFrame } 48 | 49 | procedure TAbandonedFrame.Commit; 50 | var 51 | res_type: TResType; 52 | begin 53 | FOptions.PossibleResources.Clear; 54 | 55 | for res_type in TResType do 56 | begin 57 | if edPossibleResources.Checked[Integer(res_type)] then 58 | begin 59 | FOptions.PossibleResources.Add(RESOURCE_NAMES[res_type]); 60 | end; 61 | end; 62 | end; 63 | 64 | procedure TAbandonedFrame.VisitAbandonedMine(AOptions: TAbandonedOptions); 65 | var 66 | res_type: TResType; 67 | begin 68 | FOptions:=AOptions; 69 | 70 | for res_type in TResType do 71 | begin 72 | edPossibleResources.AddItem(RESOURCE_NAMES[res_type], nil); 73 | end; 74 | 75 | for res_type in TResType do 76 | begin 77 | edPossibleResources.Checked[Integer(res_type)] := (FOptions.PossibleResources.IndexOf(RESOURCE_NAMES[res_type]) >=0); 78 | end; 79 | 80 | end; 81 | 82 | end. 83 | 84 | -------------------------------------------------------------------------------- /forms/base_options_frame.lfm: -------------------------------------------------------------------------------- 1 | object BaseOptionsFrame: TBaseOptionsFrame 2 | Left = 0 3 | Height = 240 4 | Top = 0 5 | Width = 320 6 | TabOrder = 0 7 | end 8 | -------------------------------------------------------------------------------- /forms/creature_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited CreatureFrame: TCreatureFrame 2 | Height = 457 3 | Width = 441 4 | ClientHeight = 457 5 | ClientWidth = 441 6 | Constraints.MinHeight = 400 7 | Constraints.MinWidth = 440 8 | object gbCount: TGroupBox[0] 9 | Left = 8 10 | Height = 72 11 | Top = 8 12 | Width = 425 13 | Anchors = [akTop, akLeft, akRight] 14 | Caption = 'Count' 15 | ClientHeight = 52 16 | ClientWidth = 421 17 | TabOrder = 0 18 | object edCount: TSpinEdit 19 | Left = 8 20 | Height = 23 21 | Top = 0 22 | Width = 168 23 | MaxValue = 1000000000 24 | MinValue = 1 25 | TabOrder = 0 26 | Value = 1 27 | end 28 | object edNoGrowing: TCheckBox 29 | Left = 93 30 | Height = 19 31 | Top = 32 32 | Width = 83 33 | Caption = 'No growing' 34 | TabOrder = 1 35 | end 36 | object edRandomCount: TCheckBox 37 | Left = 8 38 | Height = 19 39 | Top = 32 40 | Width = 65 41 | Caption = 'Random' 42 | OnChange = edRandomCountChange 43 | TabOrder = 2 44 | end 45 | end 46 | object rgCharacter: TRadioGroup[1] 47 | Left = 9 48 | Height = 105 49 | Top = 80 50 | Width = 425 51 | Anchors = [akTop, akLeft, akRight] 52 | AutoFill = True 53 | Caption = 'Character' 54 | ChildSizing.LeftRightSpacing = 6 55 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 56 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 57 | ChildSizing.ShrinkHorizontal = crsScaleChilds 58 | ChildSizing.ShrinkVertical = crsScaleChilds 59 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 60 | ChildSizing.ControlsPerLine = 2 61 | ClientHeight = 85 62 | ClientWidth = 421 63 | Columns = 2 64 | Items.Strings = ( 65 | 'Compliant' 66 | 'Friendly' 67 | 'Aggressive' 68 | 'Hostile' 69 | 'Savage' 70 | ) 71 | TabOrder = 1 72 | object edNeverFlees: TCheckBox 73 | Left = 210 74 | Height = 27 75 | Top = 58 76 | Width = 205 77 | Caption = 'Never flees' 78 | TabOrder = 0 79 | end 80 | end 81 | object gbReward: TGroupBox[2] 82 | Left = 8 83 | Height = 259 84 | Top = 184 85 | Width = 425 86 | Anchors = [akTop, akLeft, akRight, akBottom] 87 | Caption = 'Reward' 88 | ClientHeight = 239 89 | ClientWidth = 421 90 | TabOrder = 2 91 | object edRewardMessage: TMemo 92 | Left = 8 93 | Height = 80 94 | Top = 152 95 | Width = 400 96 | Anchors = [akTop, akLeft, akRight, akBottom] 97 | ScrollBars = ssAutoBoth 98 | TabOrder = 0 99 | end 100 | object edRewardArtifact: TComboBox 101 | Left = 112 102 | Height = 23 103 | Top = 8 104 | Width = 292 105 | Anchors = [akTop, akLeft, akRight] 106 | ItemHeight = 15 107 | TabOrder = 1 108 | end 109 | object Label1: TLabel 110 | Left = 8 111 | Height = 15 112 | Top = 11 113 | Width = 42 114 | Caption = 'Artifact:' 115 | ParentColor = False 116 | end 117 | object edWood: TSpinEdit 118 | Left = 8 119 | Height = 23 120 | Top = 48 121 | Width = 90 122 | MaxValue = 1000000000 123 | TabOrder = 2 124 | end 125 | object edCrystal: TSpinEdit 126 | Left = 8 127 | Height = 23 128 | Top = 96 129 | Width = 90 130 | MaxValue = 1000000000 131 | TabOrder = 3 132 | end 133 | object edMercury: TSpinEdit 134 | Left = 112 135 | Height = 23 136 | Top = 48 137 | Width = 90 138 | MaxValue = 1000000000 139 | TabOrder = 4 140 | end 141 | object edGems: TSpinEdit 142 | Left = 112 143 | Height = 23 144 | Top = 96 145 | Width = 90 146 | MaxValue = 1000000000 147 | TabOrder = 5 148 | end 149 | object edOre: TSpinEdit 150 | Left = 216 151 | Height = 23 152 | Top = 48 153 | Width = 90 154 | MaxValue = 1000000000 155 | TabOrder = 6 156 | end 157 | object edGold: TSpinEdit 158 | Left = 216 159 | Height = 23 160 | Top = 96 161 | Width = 90 162 | MaxValue = 1000000000 163 | TabOrder = 7 164 | end 165 | object edSulfur: TSpinEdit 166 | Left = 316 167 | Height = 23 168 | Top = 48 169 | Width = 90 170 | MaxValue = 1000000000 171 | TabOrder = 8 172 | end 173 | object Label2: TLabel 174 | Left = 8 175 | Height = 15 176 | Top = 32 177 | Width = 35 178 | Caption = 'Wood:' 179 | ParentColor = False 180 | end 181 | object Label3: TLabel 182 | Left = 8 183 | Height = 15 184 | Top = 80 185 | Width = 39 186 | Caption = 'Crystal:' 187 | ParentColor = False 188 | end 189 | object Label4: TLabel 190 | Left = 112 191 | Height = 15 192 | Top = 32 193 | Width = 47 194 | Caption = 'Mercury:' 195 | ParentColor = False 196 | end 197 | object Label5: TLabel 198 | Left = 112 199 | Height = 15 200 | Top = 80 201 | Width = 33 202 | Caption = 'Gems:' 203 | ParentColor = False 204 | end 205 | object Label6: TLabel 206 | Left = 216 207 | Height = 15 208 | Top = 32 209 | Width = 22 210 | Caption = 'Ore:' 211 | ParentColor = False 212 | end 213 | object Label7: TLabel 214 | Left = 316 215 | Height = 15 216 | Top = 32 217 | Width = 34 218 | Caption = 'Sulfur:' 219 | ParentColor = False 220 | end 221 | object Label8: TLabel 222 | Left = 216 223 | Height = 15 224 | Top = 80 225 | Width = 28 226 | Caption = 'Gold:' 227 | ParentColor = False 228 | end 229 | object edMithril: TSpinEdit 230 | Left = 318 231 | Height = 23 232 | Top = 96 233 | Width = 88 234 | TabOrder = 9 235 | Visible = False 236 | end 237 | object Label9: TLabel 238 | Left = 9 239 | Height = 15 240 | Top = 131 241 | Width = 91 242 | Caption = 'Reward message:' 243 | ParentColor = False 244 | end 245 | end 246 | end 247 | -------------------------------------------------------------------------------- /forms/creature_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit creature_frame; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 26 | Spin, ExtCtrls, object_options, editor_types, base_options_frame, gui_helpers; 27 | 28 | type 29 | 30 | { TCreatureFrame } 31 | 32 | TCreatureFrame = class(TBaseOptionsFrame) 33 | edRewardArtifact: TComboBox; 34 | edNoGrowing: TCheckBox; 35 | edRandomCount: TCheckBox; 36 | edNeverFlees: TCheckBox; 37 | gbCount: TGroupBox; 38 | edCount: TSpinEdit; 39 | gbReward: TGroupBox; 40 | edRewardMessage: TMemo; 41 | Label1: TLabel; 42 | Label2: TLabel; 43 | Label3: TLabel; 44 | Label4: TLabel; 45 | Label5: TLabel; 46 | Label6: TLabel; 47 | Label7: TLabel; 48 | Label8: TLabel; 49 | Label9: TLabel; 50 | rgCharacter: TRadioGroup; 51 | edWood: TSpinEdit; 52 | edCrystal: TSpinEdit; 53 | edMercury: TSpinEdit; 54 | edGems: TSpinEdit; 55 | edOre: TSpinEdit; 56 | edGold: TSpinEdit; 57 | edSulfur: TSpinEdit; 58 | edMithril: TSpinEdit; 59 | procedure edRandomCountChange(Sender: TObject); 60 | private 61 | FOptions: TCreatureOptions; 62 | 63 | protected 64 | procedure UpdateControls; override; 65 | public 66 | procedure Commit; override; 67 | procedure VisitMonster(AOptions: TCreatureOptions); override; 68 | end; 69 | 70 | implementation 71 | 72 | {$R *.lfm} 73 | 74 | { TCreatureFrame } 75 | 76 | procedure TCreatureFrame.edRandomCountChange(Sender: TObject); 77 | begin 78 | UpdateControls; 79 | end; 80 | 81 | procedure TCreatureFrame.UpdateControls; 82 | begin 83 | inherited UpdateControls; 84 | edCount.Enabled:=not edRandomCount.Checked; 85 | end; 86 | 87 | procedure TCreatureFrame.Commit; 88 | begin 89 | inherited Commit; 90 | 91 | if edRandomCount.Checked then 92 | begin 93 | FOptions.Amount := 0; 94 | end 95 | else begin 96 | FOptions.Amount := edCount.Value; 97 | end; 98 | 99 | FOptions.NoGrowing := edNoGrowing.Checked; 100 | 101 | FOptions.Character := TCreatureCharacter(rgCharacter.ItemIndex); 102 | FOptions.NeverFlees := edNeverFlees.Checked; 103 | FOptions.RewardMessage := edRewardMessage.Text; 104 | 105 | if edRewardArtifact.ItemIndex = -1 then 106 | begin 107 | FOptions.RewardArtifact := ''; 108 | end 109 | else begin 110 | FOptions.RewardArtifact := edRewardArtifact.SelectedInfo.Identifier; 111 | end; 112 | 113 | SaveResourceSet(gbReward, FOptions.RewardResources); 114 | end; 115 | 116 | procedure TCreatureFrame.VisitMonster(AOptions: TCreatureOptions); 117 | begin 118 | inherited VisitMonster(AOptions); 119 | FOptions := AOptions; 120 | 121 | edCount.Value := FOptions.Amount; 122 | edNoGrowing.Checked := FOptions.NoGrowing; 123 | edRandomCount.Checked := FOptions.Amount = 0; 124 | 125 | rgCharacter.ItemIndex := Integer(FOptions.Character); 126 | edNeverFlees.Checked := FOptions.NeverFlees; 127 | 128 | edRewardMessage.Text:=FOptions.RewardMessage; 129 | 130 | ReadResourceSet(gbReward, FOptions.RewardResources); 131 | 132 | edRewardArtifact.FillFromList(ListsManager.ArtifactInfos, AOptions.RewardArtifact); 133 | 134 | UpdateControls; 135 | end; 136 | 137 | end. 138 | 139 | -------------------------------------------------------------------------------- /forms/dwelling_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited DwellingFrame: TDwellingFrame 2 | Height = 390 3 | Width = 525 4 | ClientHeight = 390 5 | ClientWidth = 525 6 | Constraints.MinWidth = 330 7 | DesignLeft = 677 8 | DesignTop = 202 9 | object gbLevel: TGroupBox[0] 10 | AnchorSideLeft.Control = Owner 11 | AnchorSideTop.Control = Owner 12 | AnchorSideRight.Control = Owner 13 | AnchorSideRight.Side = asrBottom 14 | Left = 5 15 | Height = 59 16 | Top = 0 17 | Width = 515 18 | Anchors = [akTop, akLeft, akRight] 19 | BorderSpacing.Left = 5 20 | BorderSpacing.Right = 5 21 | Caption = 'Level:' 22 | ClientHeight = 39 23 | ClientWidth = 511 24 | TabOrder = 0 25 | object edMin: TSpinEdit 26 | AnchorSideLeft.Control = lbMin 27 | AnchorSideRight.Control = lbMax 28 | AnchorSideRight.Side = asrBottom 29 | Left = 140 30 | Height = 23 31 | Top = 0 32 | Width = 79 33 | Anchors = [akTop] 34 | MaxValue = 7 35 | MinValue = 1 36 | OnChange = edMinChange 37 | TabOrder = 0 38 | Value = 1 39 | end 40 | object edMax: TSpinEdit 41 | AnchorSideLeft.Control = lbMax 42 | AnchorSideLeft.Side = asrBottom 43 | AnchorSideRight.Control = gbLevel 44 | AnchorSideRight.Side = asrBottom 45 | Left = 407 46 | Height = 23 47 | Top = 0 48 | Width = 94 49 | Anchors = [akTop, akRight] 50 | BorderSpacing.Left = 10 51 | BorderSpacing.Right = 10 52 | MaxValue = 7 53 | MinValue = 1 54 | OnChange = edMaxChange 55 | TabOrder = 1 56 | Value = 1 57 | end 58 | object lbMin: TLabel 59 | AnchorSideLeft.Control = gbLevel 60 | AnchorSideRight.Control = edMin 61 | Left = 10 62 | Height = 15 63 | Top = 3 64 | Width = 120 65 | Anchors = [akTop, akLeft, akRight] 66 | BorderSpacing.Left = 10 67 | BorderSpacing.Right = 10 68 | Caption = 'Min:' 69 | ParentColor = False 70 | end 71 | object lbMax: TLabel 72 | AnchorSideLeft.Control = edMin 73 | AnchorSideLeft.Side = asrBottom 74 | AnchorSideRight.Control = edMax 75 | Left = 229 76 | Height = 15 77 | Top = 3 78 | Width = 168 79 | Anchors = [akTop, akLeft, akRight] 80 | BorderSpacing.Left = 10 81 | BorderSpacing.Right = 10 82 | Caption = 'Max:' 83 | ParentColor = False 84 | end 85 | end 86 | object gbFaction: TGroupBox[1] 87 | AnchorSideLeft.Control = Owner 88 | AnchorSideTop.Control = gbLevel 89 | AnchorSideTop.Side = asrBottom 90 | AnchorSideRight.Control = Owner 91 | AnchorSideRight.Side = asrBottom 92 | AnchorSideBottom.Control = Owner 93 | AnchorSideBottom.Side = asrBottom 94 | Left = 5 95 | Height = 321 96 | Top = 64 97 | Width = 515 98 | Anchors = [akTop, akLeft, akRight, akBottom] 99 | BorderSpacing.Around = 5 100 | Caption = 'Faction' 101 | ClientHeight = 301 102 | ClientWidth = 511 103 | TabOrder = 1 104 | object pnRandom: TPanel 105 | AnchorSideLeft.Control = gbFaction 106 | AnchorSideTop.Control = gbFaction 107 | AnchorSideRight.Control = gbFaction 108 | AnchorSideRight.Side = asrBottom 109 | Left = 6 110 | Height = 130 111 | Top = 6 112 | Width = 499 113 | Anchors = [akTop, akLeft, akRight] 114 | BorderSpacing.Around = 6 115 | BevelOuter = bvNone 116 | ClientHeight = 130 117 | ClientWidth = 499 118 | Constraints.MinHeight = 100 119 | TabOrder = 0 120 | object edFaction: TCheckListBox 121 | AnchorSideLeft.Control = pnRandom 122 | AnchorSideTop.Control = pnRandom 123 | AnchorSideRight.Control = pnRandom 124 | AnchorSideRight.Side = asrBottom 125 | AnchorSideBottom.Control = pnRandom 126 | AnchorSideBottom.Side = asrBottom 127 | Left = 5 128 | Height = 100 129 | Top = 25 130 | Width = 489 131 | Anchors = [akTop, akLeft, akRight, akBottom] 132 | BorderSpacing.Top = 20 133 | BorderSpacing.Around = 5 134 | Columns = 2 135 | ItemHeight = 0 136 | TabOrder = 0 137 | end 138 | object rbRandom: TRadioButton 139 | Left = 9 140 | Height = 19 141 | Top = 5 142 | Width = 68 143 | Caption = 'Random:' 144 | OnChange = rbRandomChange 145 | TabOrder = 1 146 | end 147 | end 148 | object pnLinked: TPanel 149 | AnchorSideLeft.Control = gbFaction 150 | AnchorSideTop.Control = pnRandom 151 | AnchorSideTop.Side = asrBottom 152 | AnchorSideRight.Control = gbFaction 153 | AnchorSideRight.Side = asrBottom 154 | AnchorSideBottom.Control = gbFaction 155 | AnchorSideBottom.Side = asrBottom 156 | Left = 5 157 | Height = 154 158 | Top = 142 159 | Width = 501 160 | Anchors = [akTop, akLeft, akRight, akBottom] 161 | BorderSpacing.Around = 5 162 | BevelOuter = bvNone 163 | ClientHeight = 154 164 | ClientWidth = 501 165 | Constraints.MinHeight = 100 166 | TabOrder = 1 167 | object rbLinked: TRadioButton 168 | Left = 8 169 | Height = 19 170 | Top = 8 171 | Width = 55 172 | Caption = 'Linked' 173 | OnChange = rbLinkedChange 174 | TabOrder = 0 175 | end 176 | object pnLink: TPanel 177 | Left = 6 178 | Height = 108 179 | Top = 40 180 | Width = 489 181 | Anchors = [akTop, akLeft, akRight, akBottom] 182 | BevelOuter = bvNone 183 | TabOrder = 1 184 | end 185 | end 186 | end 187 | end 188 | -------------------------------------------------------------------------------- /forms/dwelling_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit dwelling_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, Math, FileUtil, Forms, Controls, StdCtrls, Spin, CheckLst, 25 | ExtCtrls, object_options, base_options_frame, object_link_frame; 26 | 27 | type 28 | 29 | { TDwellingFrame } 30 | 31 | TDwellingFrame = class(TBaseOptionsFrame) 32 | edFaction: TCheckListBox; 33 | gbLevel: TGroupBox; 34 | gbFaction: TGroupBox; 35 | lbMin: TLabel; 36 | lbMax: TLabel; 37 | edMin: TSpinEdit; 38 | edMax: TSpinEdit; 39 | pnLink: TPanel; 40 | pnRandom: TPanel; 41 | pnLinked: TPanel; 42 | rbLinked: TRadioButton; 43 | rbRandom: TRadioButton; 44 | procedure edMaxChange(Sender: TObject); 45 | procedure edMinChange(Sender: TObject); 46 | procedure rbLinkedChange(Sender: TObject); 47 | procedure rbRandomChange(Sender: TObject); 48 | private 49 | FOptions: TBaseRandomDwellingOptions; 50 | FFactionsLoaded, FLevelsLoaded: Boolean; 51 | 52 | FLinkFrame: TObjectLinkFrame; 53 | 54 | procedure SetupControls; 55 | procedure LoadLevels; 56 | procedure SaveLevels; 57 | 58 | procedure LoadFactions; 59 | procedure SaveFactions; 60 | 61 | procedure LoadLink; 62 | procedure SaveLink; 63 | 64 | procedure NormalizeLevels; 65 | protected 66 | procedure UpdateControls; override; 67 | public 68 | constructor Create(TheOwner: TComponent); override; 69 | procedure Commit; override; 70 | procedure VisitRandomDwelling(AOptions: TRandomDwellingOptions); override; 71 | procedure VisitRandomDwellingLVL(AOptions: TRandomDwellingLVLOptions); override; 72 | procedure VisitRandomDwellingTown(AOptions: TRandomDwellingTownOptions); override; 73 | end; 74 | 75 | implementation 76 | 77 | uses gui_helpers; 78 | 79 | {$R *.lfm} 80 | 81 | { TDwellingFrame } 82 | 83 | procedure TDwellingFrame.edMinChange(Sender: TObject); 84 | begin 85 | NormalizeLevels; 86 | end; 87 | 88 | procedure TDwellingFrame.rbLinkedChange(Sender: TObject); 89 | begin 90 | rbRandom.Checked := not rbLinked.Checked; 91 | UpdateControls; 92 | end; 93 | 94 | procedure TDwellingFrame.rbRandomChange(Sender: TObject); 95 | begin 96 | rbLinked.Checked := not rbRandom.Checked; 97 | UpdateControls; 98 | end; 99 | 100 | procedure TDwellingFrame.edMaxChange(Sender: TObject); 101 | begin 102 | NormalizeLevels; 103 | end; 104 | 105 | procedure TDwellingFrame.SetupControls; 106 | begin 107 | FLinkFrame.Map := Map; 108 | 109 | rbLinked.Checked := FOptions.SameAsTown <> '' ; 110 | rbLinkedChange(rbLinked); 111 | 112 | UpdateControls; 113 | end; 114 | 115 | procedure TDwellingFrame.UpdateControls; 116 | begin 117 | inherited UpdateControls; 118 | edFaction.Enabled:=rbRandom.Checked; 119 | 120 | FLinkFrame.Enabled := rbLinked.Checked; 121 | end; 122 | 123 | procedure TDwellingFrame.LoadLevels; 124 | begin 125 | edMin.Value := FOptions.MinLevel; 126 | edMax.Value := FOptions.MaxLevel; 127 | FLevelsLoaded:=True; 128 | end; 129 | 130 | procedure TDwellingFrame.SaveLevels; 131 | begin 132 | FOptions.MinLevel := edMin.Value; 133 | FOptions.MaxLevel := edMax.Value; 134 | end; 135 | 136 | procedure TDwellingFrame.LoadFactions; 137 | begin 138 | edFaction.FillFrom(ListsManager.FactionInfos, FOptions.AllowedFactions); 139 | 140 | FFactionsLoaded:=True; 141 | end; 142 | 143 | procedure TDwellingFrame.SaveFactions; 144 | begin 145 | edFaction.SaveTo(FOptions.AllowedFactions, false); 146 | end; 147 | 148 | procedure TDwellingFrame.LoadLink; 149 | begin 150 | FLinkFrame.Map := Map; 151 | FLinkFrame.Load(FOptions.SameAsTown); 152 | end; 153 | 154 | procedure TDwellingFrame.SaveLink; 155 | begin 156 | if rbLinked.Checked then 157 | begin 158 | FOptions.SameAsTown := FLinkFrame.SelectedObject.Identifier; 159 | end 160 | else begin 161 | FOptions.SameAsTown := ''; 162 | end; 163 | end; 164 | 165 | procedure TDwellingFrame.NormalizeLevels; 166 | begin 167 | edMin.Value:=Min(edMin.Value,edMax.Value); 168 | edMax.Value:=Max(edMin.Value,edMax.Value); 169 | end; 170 | 171 | constructor TDwellingFrame.Create(TheOwner: TComponent); 172 | begin 173 | inherited Create(TheOwner); 174 | FLinkFrame := TObjectLinkFrame.Create(Self); 175 | FLinkFrame.Parent := pnLink; 176 | FLinkFrame.Visible := true; 177 | FLinkFrame.Align:=alClient; 178 | FLinkFrame.TypeFilter := TTownOptions; 179 | end; 180 | 181 | procedure TDwellingFrame.Commit; 182 | begin 183 | inherited Commit; 184 | if FLevelsLoaded then SaveLevels; 185 | if FFactionsLoaded then SaveFactions; 186 | 187 | SaveLink; 188 | end; 189 | 190 | procedure TDwellingFrame.VisitRandomDwelling(AOptions: TRandomDwellingOptions); 191 | begin 192 | FOptions := AOptions; 193 | SetupControls(); 194 | LoadLevels; 195 | LoadFactions; 196 | LoadLink; 197 | end; 198 | 199 | procedure TDwellingFrame.VisitRandomDwellingLVL( 200 | AOptions: TRandomDwellingLVLOptions); 201 | begin 202 | FOptions := AOptions; 203 | gbLevel.Enabled:=false; 204 | SetupControls(); 205 | LoadFactions; 206 | LoadLink; 207 | end; 208 | 209 | procedure TDwellingFrame.VisitRandomDwellingTown( 210 | AOptions: TRandomDwellingTownOptions); 211 | begin 212 | FOptions := AOptions; 213 | gbFaction.Enabled:=false; 214 | SetupControls(); 215 | LoadLevels; 216 | LoadLink; 217 | end; 218 | 219 | end. 220 | 221 | -------------------------------------------------------------------------------- /forms/edit_hero_options.lfm: -------------------------------------------------------------------------------- 1 | object EditHeroOptions: TEditHeroOptions 2 | Left = 443 3 | Height = 701 4 | Top = 122 5 | Width = 580 6 | Caption = 'Hero map-wide options' 7 | ClientHeight = 701 8 | ClientWidth = 580 9 | Position = poMainFormCenter 10 | LCLVersion = '1.6.1.0' 11 | object btOk: TButton 12 | AnchorSideRight.Control = btCancel 13 | AnchorSideBottom.Control = Owner 14 | AnchorSideBottom.Side = asrBottom 15 | Left = 404 16 | Height = 26 17 | Top = 665 18 | Width = 81 19 | Action = actSave 20 | Anchors = [akRight, akBottom] 21 | BorderSpacing.Right = 10 22 | BorderSpacing.Bottom = 10 23 | ModalResult = 1 24 | TabOrder = 1 25 | end 26 | object btCancel: TButton 27 | AnchorSideRight.Control = Owner 28 | AnchorSideRight.Side = asrBottom 29 | AnchorSideBottom.Control = Owner 30 | AnchorSideBottom.Side = asrBottom 31 | Left = 495 32 | Height = 26 33 | Top = 665 34 | Width = 75 35 | Action = actDontSave 36 | Anchors = [akRight, akBottom] 37 | BorderSpacing.Right = 10 38 | BorderSpacing.Bottom = 10 39 | ModalResult = 2 40 | TabOrder = 2 41 | end 42 | object pcMain: TPageControl 43 | AnchorSideLeft.Control = Owner 44 | AnchorSideTop.Control = Owner 45 | AnchorSideRight.Control = Owner 46 | AnchorSideRight.Side = asrBottom 47 | AnchorSideBottom.Control = Owner 48 | AnchorSideBottom.Side = asrBottom 49 | Left = 3 50 | Height = 650 51 | Top = 3 52 | Width = 574 53 | Anchors = [akTop, akLeft, akRight, akBottom] 54 | BorderSpacing.Left = 3 55 | BorderSpacing.Top = 3 56 | BorderSpacing.Right = 3 57 | BorderSpacing.Bottom = 48 58 | TabOrder = 0 59 | end 60 | object act: TActionList 61 | left = 24 62 | top = 48 63 | object actSave: TAction 64 | Caption = 'Save' 65 | OnExecute = actSaveExecute 66 | ShortCut = 16397 67 | end 68 | object actDontSave: TAction 69 | Caption = 'Don`t save' 70 | OnExecute = actDontSaveExecute 71 | ShortCut = 27 72 | end 73 | end 74 | end 75 | -------------------------------------------------------------------------------- /forms/edit_hero_options.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit edit_hero_options; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 26 | ComCtrls, ExtCtrls, ActnList, map, lists_manager, editor_str_consts, base_options_frame, 27 | hero_frame, hero_spells_frame, hero_artifacts_frame, 28 | hero_skills_frame; 29 | 30 | type 31 | 32 | { TEditHeroOptions } 33 | 34 | TEditHeroOptions = class(TForm) 35 | act: TActionList; 36 | actDontSave: TAction; 37 | actSave: TAction; 38 | btCancel: TButton; 39 | btOk: TButton; 40 | pcMain: TPageControl; 41 | procedure actDontSaveExecute(Sender: TObject); 42 | procedure actSaveExecute(Sender: TObject); 43 | private 44 | FEditors: TBaseOptionsFrameList; 45 | function GetListsManager: TListsManager; 46 | function GetMap: TVCMIMap; 47 | procedure SetListsManager(AValue: TListsManager); 48 | procedure SetMap(AValue: TVCMIMap); 49 | public 50 | constructor Create(TheOwner: TComponent); override; 51 | property Map: TVCMIMap read GetMap write SetMap; 52 | property ListsManager: TListsManager read GetListsManager write SetListsManager; 53 | 54 | procedure EditObject(AObject: THeroDefinition); 55 | end; 56 | 57 | 58 | implementation 59 | 60 | {$R *.lfm} 61 | 62 | { TEditHeroOptions } 63 | 64 | procedure TEditHeroOptions.actSaveExecute(Sender: TObject); 65 | begin 66 | FEditors.Commit; 67 | ModalResult:=mrOK; 68 | end; 69 | 70 | procedure TEditHeroOptions.actDontSaveExecute(Sender: TObject); 71 | begin 72 | ModalResult:=mrCancel; 73 | end; 74 | 75 | procedure TEditHeroOptions.SetMap(AValue: TVCMIMap); 76 | begin 77 | FEditors.Map := AValue; 78 | end; 79 | 80 | procedure TEditHeroOptions.SetListsManager(AValue: TListsManager); 81 | begin 82 | FEditors.ListsManager := AValue; 83 | end; 84 | 85 | function TEditHeroOptions.GetListsManager: TListsManager; 86 | begin 87 | Result := FEditors.ListsManager; 88 | end; 89 | 90 | function TEditHeroOptions.GetMap: TVCMIMap; 91 | begin 92 | Result := FEditors.Map; 93 | end; 94 | 95 | constructor TEditHeroOptions.Create(TheOwner: TComponent); 96 | begin 97 | inherited Create(TheOwner); 98 | FEditors := TBaseOptionsFrameList.Create(Self); 99 | 100 | end; 101 | 102 | procedure TEditHeroOptions.EditObject(AObject: THeroDefinition); 103 | begin 104 | FEditors.AddFrame(THeroFrame, AObject, rsTabMainOptions, pcMain); 105 | FEditors.AddFrame(THeroSkillsFrame, AObject, rsTabSecondarySkills, pcMain); 106 | FEditors.AddFrame(THeroArtifactsFrame, AObject, rsTabArtifacts, pcMain); 107 | FEditors.AddFrame(THeroSpellsFrame, AObject, rsTabSpells, pcMain); 108 | 109 | pcMain.ActivePage := pcMain.Pages[0]; 110 | 111 | ShowModal; 112 | end; 113 | 114 | end. 115 | 116 | -------------------------------------------------------------------------------- /forms/edit_object_options.lfm: -------------------------------------------------------------------------------- 1 | object EditObjectOptions: TEditObjectOptions 2 | Left = 458 3 | Height = 609 4 | Top = 122 5 | Width = 762 6 | ActiveControl = pcMain 7 | Caption = 'EditObjectOptions' 8 | ClientHeight = 609 9 | ClientWidth = 762 10 | Constraints.MinHeight = 300 11 | Constraints.MinWidth = 300 12 | Position = poMainFormCenter 13 | ShowInTaskBar = stNever 14 | object pcMain: TPageControl 15 | Left = 0 16 | Height = 569 17 | Top = 0 18 | Width = 762 19 | ActivePage = tsCommon 20 | Align = alClient 21 | BorderSpacing.Bottom = 40 22 | TabIndex = 0 23 | TabOrder = 0 24 | object tsCommon: TTabSheet 25 | Caption = 'Main options' 26 | ClientHeight = 541 27 | ClientWidth = 754 28 | TabVisible = False 29 | object lbNothingToEdit: TLabel 30 | Left = 12 31 | Height = 15 32 | Top = 10 33 | Width = 184 34 | Caption = 'Object have no editable properties.' 35 | ParentColor = False 36 | end 37 | end 38 | end 39 | object btOk: TButton 40 | Left = 592 41 | Height = 25 42 | Top = 577 43 | Width = 75 44 | Action = actSave 45 | Anchors = [akRight, akBottom] 46 | TabOrder = 1 47 | end 48 | object btCancel: TButton 49 | Left = 680 50 | Height = 25 51 | Top = 577 52 | Width = 75 53 | Action = actDontSave 54 | Anchors = [akRight, akBottom] 55 | TabOrder = 2 56 | end 57 | object ErrorLabel: TLabel 58 | Left = 14 59 | Height = 23 60 | Top = 579 61 | Width = 570 62 | AutoSize = False 63 | Font.Color = clRed 64 | ParentColor = False 65 | ParentFont = False 66 | Visible = False 67 | end 68 | object act: TActionList 69 | left = 16 70 | top = 64 71 | object actSave: TAction 72 | Caption = 'Save' 73 | OnExecute = actSaveExecute 74 | OnUpdate = actSaveUpdate 75 | ShortCut = 16397 76 | end 77 | object actDontSave: TAction 78 | Caption = 'Don`t save' 79 | OnExecute = actDontSaveExecute 80 | ShortCut = 27 81 | end 82 | end 83 | end 84 | -------------------------------------------------------------------------------- /forms/edit_triggered_events.lfm: -------------------------------------------------------------------------------- 1 | object TriggeredEventsForm: TTriggeredEventsForm 2 | Left = 612 3 | Height = 544 4 | Top = 166 5 | Width = 491 6 | Caption = 'Victory-loss conditions' 7 | ClientHeight = 544 8 | ClientWidth = 491 9 | Constraints.MinHeight = 400 10 | Constraints.MinWidth = 400 11 | Position = poScreenCenter 12 | LCLVersion = '1.6.3.0' 13 | object btOk: TButton 14 | AnchorSideRight.Control = btCancel 15 | AnchorSideBottom.Control = Owner 16 | AnchorSideBottom.Side = asrBottom 17 | Left = 315 18 | Height = 26 19 | Top = 508 20 | Width = 81 21 | Action = actSave 22 | Anchors = [akRight, akBottom] 23 | BorderSpacing.Right = 10 24 | BorderSpacing.Bottom = 10 25 | TabOrder = 0 26 | end 27 | object btCancel: TButton 28 | AnchorSideRight.Control = Owner 29 | AnchorSideRight.Side = asrBottom 30 | AnchorSideBottom.Control = Owner 31 | AnchorSideBottom.Side = asrBottom 32 | Left = 406 33 | Height = 26 34 | Top = 508 35 | Width = 75 36 | Action = actDontSave 37 | Anchors = [akRight, akBottom] 38 | BorderSpacing.Right = 10 39 | BorderSpacing.Bottom = 10 40 | ModalResult = 2 41 | TabOrder = 1 42 | end 43 | object ErrorLabel: TLabel 44 | Left = 16 45 | Height = 40 46 | Top = 492 47 | Width = 294 48 | Anchors = [akLeft, akRight, akBottom] 49 | AutoSize = False 50 | Caption = 'ErrorLabel' 51 | Font.Color = 8421631 52 | Layout = tlBottom 53 | ParentColor = False 54 | ParentFont = False 55 | Visible = False 56 | WordWrap = True 57 | end 58 | object lbEvents: TLabel 59 | Left = 8 60 | Height = 15 61 | Top = 83 62 | Width = 37 63 | Caption = 'Events:' 64 | ParentColor = False 65 | end 66 | object VictoryText: TEdit 67 | Left = 80 68 | Height = 23 69 | Top = 8 70 | Width = 401 71 | Anchors = [akTop, akLeft, akRight] 72 | TabOrder = 2 73 | end 74 | object VictoryTextLabel: TLabel 75 | Left = 8 76 | Height = 15 77 | Top = 16 78 | Width = 62 79 | Caption = 'Victory text:' 80 | ParentColor = False 81 | end 82 | object DefeatText: TEdit 83 | Left = 80 84 | Height = 23 85 | Top = 45 86 | Width = 401 87 | Anchors = [akTop, akLeft, akRight] 88 | TabOrder = 3 89 | end 90 | object DefeatTextLabel: TLabel 91 | Left = 8 92 | Height = 15 93 | Top = 53 94 | Width = 59 95 | Caption = 'Defeat text:' 96 | ParentColor = False 97 | end 98 | object ToolBar1: TToolBar 99 | Left = 83 100 | Height = 26 101 | Top = 80 102 | Width = 398 103 | Align = alNone 104 | Anchors = [akTop, akLeft, akRight] 105 | Caption = 'ToolBar1' 106 | EdgeBorders = [] 107 | EdgeInner = esNone 108 | EdgeOuter = esNone 109 | ShowCaptions = True 110 | TabOrder = 4 111 | object ToolButton1: TToolButton 112 | Left = 1 113 | Top = 0 114 | Action = actAdd 115 | end 116 | object ToolButton2: TToolButton 117 | Left = 31 118 | Top = 0 119 | Action = actRemove 120 | end 121 | object ToolButton3: TToolButton 122 | Left = 82 123 | Top = 0 124 | Action = actRename 125 | end 126 | end 127 | object pcEvents: TPageControl 128 | Left = 8 129 | Height = 378 130 | Top = 108 131 | Width = 475 132 | Align = alClient 133 | BorderSpacing.Top = 100 134 | BorderSpacing.Bottom = 50 135 | BorderSpacing.Around = 8 136 | TabOrder = 5 137 | OnChanging = pcEventsChanging 138 | OnCloseTabClicked = pcEventsCloseTabClicked 139 | end 140 | object act: TActionList 141 | left = 424 142 | top = 24 143 | object actSave: TAction 144 | Caption = 'Save' 145 | OnExecute = actSaveExecute 146 | OnUpdate = actSaveUpdate 147 | ShortCut = 16397 148 | end 149 | object actDontSave: TAction 150 | Caption = 'Don`t save' 151 | OnExecute = actDontSaveExecute 152 | ShortCut = 27 153 | end 154 | object actAdd: TAction 155 | Caption = 'Add' 156 | OnExecute = actAddExecute 157 | end 158 | object actRemove: TAction 159 | Caption = 'Remove' 160 | OnExecute = actRemoveExecute 161 | OnUpdate = actRemoveUpdate 162 | end 163 | object actRename: TAction 164 | Caption = 'Rename' 165 | OnExecute = actRenameExecute 166 | OnUpdate = actRenameUpdate 167 | end 168 | end 169 | object JsonSyn: TSynAnySyn 170 | Enabled = False 171 | Comments = [csCStyle] 172 | DetectPreprocessor = False 173 | IdentifierChars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz' 174 | StringAttri.Style = [fsBold] 175 | StringDelim = sdDoubleQuote 176 | Markup = True 177 | Entity = False 178 | DollarVariables = False 179 | ActiveDot = False 180 | left = 496 181 | top = 16 182 | end 183 | end 184 | -------------------------------------------------------------------------------- /forms/flaggable_object_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited FlaggableFrame: TFlaggableFrame 2 | object edOwnerRG: TRadioGroup[0] 3 | Left = 15 4 | Height = 216 5 | Top = 8 6 | Width = 289 7 | Anchors = [akTop, akLeft, akRight, akBottom] 8 | AutoFill = True 9 | Caption = 'Owner:' 10 | ChildSizing.LeftRightSpacing = 6 11 | ChildSizing.TopBottomSpacing = 6 12 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 13 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 14 | ChildSizing.ShrinkHorizontal = crsScaleChilds 15 | ChildSizing.ShrinkVertical = crsScaleChilds 16 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 17 | ChildSizing.ControlsPerLine = 1 18 | TabOrder = 0 19 | end 20 | end 21 | -------------------------------------------------------------------------------- /forms/flaggable_object_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit flaggable_object_frame; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 26 | ExtCtrls, object_options, base_options_frame; 27 | 28 | type 29 | 30 | { TFlaggableFrame } 31 | 32 | TFlaggableFrame = class(TBaseOptionsFrame) 33 | edOwnerRG: TRadioGroup; 34 | strict private 35 | FObject: TObjectOptions; 36 | procedure SetupControls; 37 | private 38 | procedure VisitOptions(AOptions:TObjectOptions); 39 | public 40 | { public declarations } 41 | procedure Commit; override; 42 | procedure VisitMine(AOptions: TMineOptions); override; 43 | procedure VisitOwnedObject(AOptions: TOwnedObjectOptions); override; 44 | procedure VisitRandomDwelling(AOptions: TRandomDwellingOptions); override; 45 | procedure VisitRandomDwellingLVL(AOptions: TRandomDwellingLVLOptions); override; 46 | procedure VisitRandomDwellingTown(AOptions: TRandomDwellingTownOptions); override; 47 | procedure VisitGarrison(AOptions: TGarrisonOptions); override; 48 | end; 49 | 50 | implementation 51 | 52 | 53 | {$R *.lfm} 54 | 55 | { TFlaggableFrame } 56 | 57 | procedure TFlaggableFrame.Commit; 58 | begin 59 | inherited Commit; 60 | WriteOwner(FObject, edOwnerRG); 61 | end; 62 | 63 | procedure TFlaggableFrame.VisitMine(AOptions: TMineOptions); 64 | begin 65 | VisitOptions(AOptions); 66 | end; 67 | 68 | procedure TFlaggableFrame.SetupControls; 69 | begin 70 | ListsManager.FillWithPlayers(edOwnerRG.Items, True); 71 | end; 72 | 73 | procedure TFlaggableFrame.VisitOptions(AOptions: TObjectOptions); 74 | begin 75 | SetupControls; 76 | FObject := AOptions; 77 | ReadOwner(FObject, edOwnerRG); 78 | end; 79 | 80 | procedure TFlaggableFrame.VisitOwnedObject(AOptions: TOwnedObjectOptions); 81 | begin 82 | VisitOptions(AOptions); 83 | end; 84 | 85 | procedure TFlaggableFrame.VisitRandomDwelling(AOptions: TRandomDwellingOptions); 86 | begin 87 | VisitOptions(AOptions); 88 | end; 89 | 90 | procedure TFlaggableFrame.VisitRandomDwellingLVL( 91 | AOptions: TRandomDwellingLVLOptions); 92 | begin 93 | VisitOptions(AOptions); 94 | end; 95 | 96 | procedure TFlaggableFrame.VisitRandomDwellingTown( 97 | AOptions: TRandomDwellingTownOptions); 98 | begin 99 | VisitOptions(AOptions); 100 | end; 101 | 102 | procedure TFlaggableFrame.VisitGarrison(AOptions: TGarrisonOptions); 103 | begin 104 | VisitOptions(AOptions); 105 | end; 106 | 107 | end. 108 | 109 | -------------------------------------------------------------------------------- /forms/grail_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited GrailFrame: TGrailFrame 2 | object lbRadius: TLabel[0] 3 | Left = 11 4 | Height = 15 5 | Top = 11 6 | Width = 140 7 | Caption = 'Allowed placement radius:' 8 | ParentColor = False 9 | end 10 | object edRadius: TSpinEdit[1] 11 | Left = 11 12 | Height = 23 13 | Top = 33 14 | Width = 126 15 | TabOrder = 0 16 | end 17 | end 18 | -------------------------------------------------------------------------------- /forms/grail_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit grail_frame; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 26 | Spin, object_options, base_options_frame; 27 | 28 | type 29 | 30 | { TGrailFrame } 31 | 32 | TGrailFrame = class(TBaseOptionsFrame) 33 | lbRadius: TLabel; 34 | edRadius: TSpinEdit; 35 | strict private 36 | FObject: TGrailOptions; 37 | public 38 | procedure Commit; override; 39 | procedure VisitGrail(AOptions: TGrailOptions); override; 40 | end; 41 | 42 | implementation 43 | 44 | {$R *.lfm} 45 | 46 | { TGrailFrame } 47 | 48 | procedure TGrailFrame.Commit; 49 | begin 50 | inherited Commit; 51 | FObject.Radius := edRadius.Value; 52 | end; 53 | 54 | procedure TGrailFrame.VisitGrail(AOptions: TGrailOptions); 55 | begin 56 | inherited VisitGrail(AOptions); 57 | FObject := AOptions; 58 | edRadius.Value := AOptions.Radius; 59 | end; 60 | 61 | end. 62 | 63 | -------------------------------------------------------------------------------- /forms/hero_artifacts_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited HeroArtifactsFrame: THeroArtifactsFrame 2 | Height = 525 3 | Width = 514 4 | ClientHeight = 525 5 | ClientWidth = 514 6 | object Splitter1: TSplitter[0] 7 | Cursor = crVSplit 8 | Left = 0 9 | Height = 5 10 | Top = 368 11 | Width = 514 12 | Align = alBottom 13 | Beveled = True 14 | ResizeAnchor = akBottom 15 | ResizeStyle = rsPattern 16 | end 17 | object pnBackpack: TPanel[1] 18 | Left = 0 19 | Height = 152 20 | Top = 373 21 | Width = 514 22 | Align = alBottom 23 | BevelOuter = bvNone 24 | Caption = 'pnBackpack' 25 | ClientHeight = 152 26 | ClientWidth = 514 27 | TabOrder = 0 28 | object BackPack: TStringGrid 29 | Left = 0 30 | Height = 152 31 | Top = 0 32 | Width = 514 33 | Align = alClient 34 | AutoFillColumns = True 35 | ColCount = 1 36 | Columns = < 37 | item 38 | MinSize = 100 39 | MaxSize = 1000 40 | Title.Caption = 'Backpack' 41 | Width = 513 42 | end> 43 | FixedCols = 0 44 | Flat = True 45 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAutoAddRows, goSmoothScroll] 46 | RowCount = 1 47 | TabOrder = 0 48 | OnKeyDown = BackPackKeyDown 49 | OnResize = BackPackResize 50 | OnSelectEditor = BackPackSelectEditor 51 | ColWidths = ( 52 | 513 53 | ) 54 | end 55 | object BackpackSelector: TComboBox 56 | Left = 16 57 | Height = 23 58 | Top = 32 59 | Width = 200 60 | ItemHeight = 15 61 | OnCloseUp = BackpackSelectorCloseUp 62 | OnEditingDone = BackpackSelectorEditingDone 63 | OnKeyDown = BackpackSelectorKeyDown 64 | Style = csDropDownList 65 | TabOrder = 1 66 | Visible = False 67 | end 68 | end 69 | object pnSlots: TPanel[2] 70 | Left = 0 71 | Height = 349 72 | Top = 19 73 | Width = 514 74 | Align = alClient 75 | BevelOuter = bvNone 76 | ChildSizing.LeftRightSpacing = 5 77 | ChildSizing.TopBottomSpacing = 5 78 | ChildSizing.HorizontalSpacing = 15 79 | ChildSizing.VerticalSpacing = 5 80 | ChildSizing.EnlargeHorizontal = crsScaleChilds 81 | ChildSizing.EnlargeVertical = crsScaleChilds 82 | ChildSizing.ShrinkHorizontal = crsScaleChilds 83 | ChildSizing.ShrinkVertical = crsScaleChilds 84 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 85 | ChildSizing.ControlsPerLine = 4 86 | TabOrder = 2 87 | end 88 | object Panel1: TPanel[3] 89 | Left = 0 90 | Height = 19 91 | Top = 0 92 | Width = 514 93 | Align = alTop 94 | AutoSize = True 95 | BevelOuter = bvNone 96 | ClientHeight = 19 97 | ClientWidth = 514 98 | TabOrder = 3 99 | object cbCustomise: TCheckBox 100 | Left = 0 101 | Height = 19 102 | Top = 0 103 | Width = 514 104 | Align = alTop 105 | AutoSize = False 106 | Caption = 'Customise' 107 | TabOrder = 0 108 | end 109 | end 110 | end 111 | -------------------------------------------------------------------------------- /forms/hero_spells_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited HeroSpellsFrame: THeroSpellsFrame 2 | Height = 288 3 | Width = 408 4 | ClientHeight = 288 5 | ClientWidth = 408 6 | OnResize = FrameResize 7 | object Spellbook: TCheckListBox[0] 8 | Left = 0 9 | Height = 269 10 | Top = 19 11 | Width = 408 12 | Align = alClient 13 | Columns = 2 14 | ItemHeight = 0 15 | TabOrder = 0 16 | end 17 | object cbCustomise: TCheckBox[1] 18 | Left = 0 19 | Height = 19 20 | Top = 0 21 | Width = 408 22 | Align = alTop 23 | Caption = 'Customise' 24 | TabOrder = 1 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /forms/hero_spells_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit hero_spells_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, math, FileUtil, Forms, Controls, Graphics, Dialogs, 25 | CheckLst, ExtCtrls, StdCtrls, base_options_frame, gui_helpers, object_options, 26 | Map, editor_classes, lists_manager, base_info; 27 | 28 | type 29 | //todo: use hero definition 30 | 31 | { THeroSpellsFrame } 32 | 33 | THeroSpellsFrame = class(TBaseOptionsFrame) 34 | cbCustomise: TCheckBox; 35 | Spellbook: TCheckListBox; 36 | procedure FrameResize(Sender: TObject); 37 | private 38 | FDefaults: TStrings; 39 | FCache: TStrings; 40 | FTarget:TStrings; 41 | 42 | procedure Clear; 43 | 44 | procedure ReadData; 45 | 46 | procedure cbCustomiseChange(Sender: TObject); 47 | 48 | procedure LoadDefaultSpells(AHeroId: AnsiString); 49 | 50 | procedure FillSpellbook(ASrc: TStrings); 51 | 52 | protected 53 | procedure Load; override; 54 | procedure ApplyDefaults; override; 55 | procedure ReloadDefaults; override; 56 | procedure UpdateControls; override; 57 | public 58 | constructor Create(TheOwner: TComponent); override; 59 | destructor Destroy; override; 60 | procedure Commit; override; 61 | procedure VisitHero(AOptions: THeroOptions); override; 62 | procedure VisitHeroDefinition(AOptions: THeroDefinition); override; 63 | end; 64 | 65 | implementation 66 | 67 | {$R *.lfm} 68 | 69 | { THeroSpellsFrame } 70 | 71 | procedure THeroSpellsFrame.ReadData; 72 | begin 73 | cbCustomise.OnChange:=nil; 74 | cbCustomise.Checked:=not (FCache.Count = 0); 75 | cbCustomise.OnChange:=@cbCustomiseChange; 76 | UpdateControls; 77 | end; 78 | 79 | procedure THeroSpellsFrame.cbCustomiseChange(Sender: TObject); 80 | begin 81 | UpdateControls; 82 | end; 83 | 84 | procedure THeroSpellsFrame.LoadDefaultSpells(AHeroId: AnsiString); 85 | var 86 | hero_info: THeroInfo; 87 | definition: THeroDefinition; 88 | begin 89 | FDefaults.Clear; 90 | 91 | if AHeroId = '' then 92 | Exit; 93 | 94 | hero_info := ListsManager.Heroes[AHeroId]; 95 | definition := nil; 96 | 97 | if FUseMapDefaults then 98 | begin 99 | definition := Map.PredefinedHeroes.FindItem(AHeroId); 100 | end; 101 | 102 | if Assigned(definition) and (definition.Spellbook.Count <> 0) then 103 | FDefaults.Assign(definition.Spellbook) 104 | else if Assigned(hero_info) then 105 | FDefaults.Assign(hero_info.SpellBook); 106 | end; 107 | 108 | procedure THeroSpellsFrame.FillSpellbook(ASrc: TStrings); 109 | begin 110 | Spellbook.FillFrom(ListsManager.SpellInfos, ASrc); 111 | end; 112 | 113 | constructor THeroSpellsFrame.Create(TheOwner: TComponent); 114 | begin 115 | inherited Create(TheOwner); 116 | FCache := TStringList.Create; 117 | FDefaults := TStringList.Create; 118 | end; 119 | 120 | destructor THeroSpellsFrame.Destroy; 121 | begin 122 | FDefaults.Free; 123 | FCache.Free; 124 | inherited Destroy; 125 | end; 126 | 127 | procedure THeroSpellsFrame.FrameResize(Sender: TObject); 128 | begin 129 | Spellbook.Columns := Max(1, (Width div 300) +1); 130 | end; 131 | 132 | procedure THeroSpellsFrame.Load; 133 | begin 134 | FillSpellbook(FCache); 135 | end; 136 | 137 | procedure THeroSpellsFrame.ApplyDefaults; 138 | begin 139 | inherited ApplyDefaults; 140 | FillSpellbook(FCache); 141 | end; 142 | 143 | procedure THeroSpellsFrame.ReloadDefaults; 144 | begin 145 | inherited ReloadDefaults; 146 | LoadDefaultSpells(InstanceType); 147 | end; 148 | 149 | procedure THeroSpellsFrame.Clear; 150 | begin 151 | Spellbook.SaveTo(FCache); 152 | FillSpellbook(FDefaults); 153 | end; 154 | 155 | procedure THeroSpellsFrame.UpdateControls; 156 | begin 157 | inherited UpdateControls; 158 | Spellbook.Enabled := cbCustomise.Checked; 159 | 160 | if cbCustomise.Checked then 161 | Load() 162 | else 163 | Clear(); 164 | end; 165 | 166 | procedure THeroSpellsFrame.Commit; 167 | begin 168 | inherited Commit; 169 | Spellbook.SaveTo(FCache); 170 | if not cbCustomise.Checked then 171 | begin 172 | FTarget.Clear; 173 | end 174 | else if FCache.Count = 0 then 175 | begin 176 | FTarget.Clear; 177 | FTarget.Add(''); 178 | end 179 | else 180 | begin 181 | FTarget.Assign(FCache); 182 | end; 183 | end; 184 | 185 | procedure THeroSpellsFrame.VisitHero(AOptions: THeroOptions); 186 | begin 187 | FUseMapDefaults:=True; 188 | inherited VisitHero(AOptions);//continue dispatch 189 | 190 | FTarget := AOptions.SpellBook; 191 | FCache.Assign(FTarget); 192 | 193 | LoadDefaultSpells(AOptions.&type); 194 | 195 | ReadData; 196 | end; 197 | 198 | procedure THeroSpellsFrame.VisitHeroDefinition(AOptions: THeroDefinition); 199 | begin 200 | FUseMapDefaults:=False; 201 | inherited VisitHeroDefinition(AOptions);//continue dispatch 202 | 203 | LoadDefaultSpells(AOptions.Identifier); 204 | 205 | FTarget := AOptions.SpellBook; 206 | FCache.Assign(FTarget); 207 | 208 | LoadDefaultSpells(AOptions.Identifier); 209 | 210 | ReadData; 211 | end; 212 | 213 | end. 214 | 215 | -------------------------------------------------------------------------------- /forms/local_event_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited LocalEventFrame: TLocalEventFrame 2 | Height = 354 3 | Width = 420 4 | ClientHeight = 354 5 | ClientWidth = 420 6 | Constraints.MinHeight = 350 7 | Constraints.MinWidth = 300 8 | DesignLeft = -3 9 | DesignTop = -3 10 | object edActivableBy: TComboBox[0] 11 | Left = 16 12 | Height = 23 13 | Top = 168 14 | Width = 396 15 | Anchors = [akLeft, akRight, akBottom] 16 | ItemHeight = 15 17 | Items.Strings = ( 18 | 'Only human' 19 | 'Only AI' 20 | 'Any player' 21 | ) 22 | TabOrder = 0 23 | end 24 | object Label1: TLabel[1] 25 | Left = 16 26 | Height = 15 27 | Top = 144 28 | Width = 68 29 | Anchors = [akLeft, akBottom] 30 | Caption = 'Activable by:' 31 | ParentColor = False 32 | end 33 | object edPlayers: TCheckGroup[2] 34 | Left = 16 35 | Height = 128 36 | Top = 208 37 | Width = 397 38 | Anchors = [akLeft, akRight, akBottom] 39 | AutoFill = True 40 | Caption = 'Activable by players:' 41 | ChildSizing.LeftRightSpacing = 6 42 | ChildSizing.TopBottomSpacing = 6 43 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 44 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 45 | ChildSizing.ShrinkHorizontal = crsScaleChilds 46 | ChildSizing.ShrinkVertical = crsScaleChilds 47 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 48 | ChildSizing.ControlsPerLine = 2 49 | ClientHeight = 108 50 | ClientWidth = 393 51 | Columns = 2 52 | Items.Strings = ( 53 | 'Red' 54 | 'Blue' 55 | 'Tan' 56 | 'Green' 57 | 'Orange' 58 | 'Purple' 59 | 'Teal' 60 | 'Pink' 61 | ) 62 | TabOrder = 1 63 | Data = { 64 | 080000000202020202020202 65 | } 66 | end 67 | object edRemoveAfterVisit: TCheckBox[3] 68 | Left = 16 69 | Height = 19 70 | Top = 112 71 | Width = 114 72 | Anchors = [akLeft, akBottom] 73 | Caption = 'Remove after visit' 74 | TabOrder = 2 75 | end 76 | object MessageEdit: TMemo[4] 77 | Left = 16 78 | Height = 69 79 | Top = 32 80 | Width = 395 81 | Anchors = [akTop, akLeft, akRight, akBottom] 82 | ScrollBars = ssAutoBoth 83 | TabOrder = 3 84 | end 85 | object MessageLabel: TLabel[5] 86 | Left = 16 87 | Height = 15 88 | Top = 8 89 | Width = 49 90 | Caption = 'Message:' 91 | ParentColor = False 92 | end 93 | end 94 | -------------------------------------------------------------------------------- /forms/local_event_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit local_event_frame; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 26 | ExtCtrls, base_options_frame, gui_helpers, object_options, 27 | editor_types; 28 | 29 | type 30 | 31 | { TLocalEventFrame } 32 | 33 | TLocalEventFrame = class(TBaseOptionsFrame) 34 | edRemoveAfterVisit: TCheckBox; 35 | edPlayers: TCheckGroup; 36 | edActivableBy: TComboBox; 37 | Label1: TLabel; 38 | MessageEdit: TMemo; 39 | MessageLabel: TLabel; 40 | private 41 | FOptions: TLocalEventOptions; 42 | public 43 | { public declarations } 44 | procedure VisitLocalEvent(AOptions: TLocalEventOptions); override; 45 | procedure Commit; override; 46 | end; 47 | 48 | implementation 49 | 50 | {$R *.lfm} 51 | 52 | { TLocalEventFrame } 53 | 54 | procedure TLocalEventFrame.VisitLocalEvent(AOptions: TLocalEventOptions); 55 | var 56 | pl: TPlayer; 57 | begin 58 | FOptions := AOptions; 59 | 60 | inherited VisitLocalEvent(AOptions); 61 | 62 | AddStrEditor(AOptions, 'GuardMessage', MessageEdit); 63 | AddBoolEditor(AOptions, 'RemoveAfterVisit', edRemoveAfterVisit); 64 | 65 | if FOptions.HumanActivable then 66 | begin 67 | if AOptions.AIActivable then 68 | begin 69 | edActivableBy.ItemIndex:=2; 70 | end 71 | else begin 72 | edActivableBy.ItemIndex:=0; 73 | end; 74 | end 75 | else begin 76 | edActivableBy.ItemIndex:=1; 77 | end; 78 | 79 | for pl in TPlayerColor do 80 | begin 81 | edPlayers.Checked[Integer(pl)] := FOptions.AvailableFor * [pl] = [pl]; 82 | end; 83 | 84 | Load(); 85 | end; 86 | 87 | procedure TLocalEventFrame.Commit; 88 | var 89 | pl: TPlayer; 90 | begin 91 | inherited Commit; 92 | 93 | case edActivableBy.ItemIndex of 94 | 0:begin FOptions.HumanActivable := true; FOptions.AIActivable:=False; end; 95 | 1:begin FOptions.HumanActivable := False; FOptions.AIActivable:=True; end; 96 | 2:begin FOptions.HumanActivable := true; FOptions.AIActivable:=True; end; 97 | end; 98 | 99 | FOptions.AvailableFor := []; 100 | 101 | for pl in TPlayerColor do 102 | begin 103 | if edPlayers.Checked[Integer(pl)] then 104 | begin 105 | FOptions.AvailableFor := FOptions.AvailableFor + [pl]; 106 | end; 107 | end; 108 | 109 | end; 110 | 111 | end. 112 | 113 | -------------------------------------------------------------------------------- /forms/message_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited MessageFrame: TMessageFrame 2 | Height = 208 3 | Width = 398 4 | ClientHeight = 208 5 | ClientWidth = 398 6 | DesignLeft = 414 7 | DesignTop = 102 8 | object lbMessage: TLabel[0] 9 | Left = 8 10 | Height = 15 11 | Top = 2 12 | Width = 49 13 | Caption = 'Message:' 14 | ParentColor = False 15 | end 16 | object edMessage: TMemo[1] 17 | Left = 8 18 | Height = 176 19 | Top = 24 20 | Width = 384 21 | Anchors = [akTop, akLeft, akRight, akBottom] 22 | TabOrder = 0 23 | end 24 | end 25 | -------------------------------------------------------------------------------- /forms/message_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit message_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 25 | base_options_frame, object_options; 26 | 27 | type 28 | 29 | { TMessageFrame } 30 | 31 | TMessageFrame = class(TBaseOptionsFrame) 32 | edMessage: TMemo; 33 | lbMessage: TLabel; 34 | public 35 | procedure Commit; override; 36 | 37 | function IsDirty: Boolean; override; 38 | 39 | procedure VisitArtifact(AOptions: TArtifactOptions); override; 40 | procedure VisitPandorasBox(AOptions: TPandorasOptions); override; 41 | procedure VisitSignBottle(AOptions: TSignBottleOptions); override; 42 | end; 43 | 44 | implementation 45 | 46 | {$R *.lfm} 47 | 48 | { TMessageFrame } 49 | 50 | procedure TMessageFrame.Commit; 51 | begin 52 | inherited Commit; 53 | end; 54 | 55 | function TMessageFrame.IsDirty: Boolean; 56 | begin 57 | Result:=InternalIsDirty; 58 | end; 59 | 60 | procedure TMessageFrame.VisitArtifact(AOptions: TArtifactOptions); 61 | begin 62 | inherited VisitArtifact(AOptions); 63 | AddStrEditor(AOptions, 'GuardMessage', edMessage); 64 | Load; 65 | end; 66 | 67 | procedure TMessageFrame.VisitPandorasBox(AOptions: TPandorasOptions); 68 | begin 69 | inherited VisitPandorasBox(AOptions); 70 | AddStrEditor(AOptions, 'GuardMessage', edMessage); 71 | Load; 72 | end; 73 | 74 | procedure TMessageFrame.VisitSignBottle(AOptions: TSignBottleOptions); 75 | begin 76 | inherited VisitSignBottle(AOptions); 77 | AddStrEditor(AOptions, 'Text', edMessage); 78 | Load; 79 | end; 80 | 81 | end. 82 | 83 | -------------------------------------------------------------------------------- /forms/new_map.lfm: -------------------------------------------------------------------------------- 1 | object NewMapForm: TNewMapForm 2 | Left = 445 3 | Height = 224 4 | Top = 193 5 | Width = 300 6 | BorderStyle = bsDialog 7 | Caption = 'New map' 8 | ClientHeight = 224 9 | ClientWidth = 300 10 | Constraints.MinHeight = 200 11 | Constraints.MinWidth = 300 12 | OnCreate = FormCreate 13 | Position = poMainFormCenter 14 | ShowInTaskBar = stNever 15 | LCLVersion = '1.8.1.0' 16 | object pnButtons: TPanel 17 | Left = 0 18 | Height = 43 19 | Top = 181 20 | Width = 300 21 | Align = alBottom 22 | BevelOuter = bvNone 23 | ClientHeight = 43 24 | ClientWidth = 300 25 | TabOrder = 0 26 | object btOk: TButton 27 | Left = 56 28 | Height = 23 29 | Top = 11 30 | Width = 59 31 | Action = actCreate 32 | TabOrder = 0 33 | end 34 | object btCancel: TButton 35 | Left = 184 36 | Height = 23 37 | Top = 11 38 | Width = 59 39 | Action = actCancel 40 | TabOrder = 1 41 | end 42 | end 43 | object edWidth: TSpinEdit 44 | Left = 16 45 | Height = 23 46 | Top = 72 47 | Width = 110 48 | Increment = 9 49 | MaxValue = 1008 50 | MinValue = 18 51 | OnChange = edWidthChange 52 | TabOrder = 1 53 | Value = 36 54 | end 55 | object edHeight: TSpinEdit 56 | Left = 152 57 | Height = 23 58 | Top = 72 59 | Width = 110 60 | Increment = 9 61 | MaxValue = 1008 62 | MinValue = 18 63 | OnChange = edHeightChange 64 | TabOrder = 2 65 | Value = 36 66 | end 67 | object lbWidth: TLabel 68 | Left = 17 69 | Height = 15 70 | Top = 56 71 | Width = 32 72 | Caption = 'Width' 73 | ParentColor = False 74 | end 75 | object lbHeight: TLabel 76 | Left = 152 77 | Height = 15 78 | Top = 56 79 | Width = 36 80 | Caption = 'Height' 81 | ParentColor = False 82 | end 83 | object edLevels: TSpinEdit 84 | Left = 16 85 | Height = 23 86 | Top = 144 87 | Width = 112 88 | MaxValue = 2 89 | MinValue = 1 90 | TabOrder = 3 91 | Value = 1 92 | end 93 | object lbLevels: TLabel 94 | Left = 16 95 | Height = 15 96 | Top = 128 97 | Width = 32 98 | Caption = 'Levels' 99 | ParentColor = False 100 | end 101 | object cbSquare: TCheckBox 102 | Left = 16 103 | Height = 19 104 | Top = 104 105 | Width = 83 106 | Caption = 'Square map' 107 | Checked = True 108 | OnChange = cbSquareChange 109 | State = cbChecked 110 | TabOrder = 4 111 | end 112 | object Label1: TLabel 113 | Left = 17 114 | Height = 15 115 | Top = 11 116 | Width = 72 117 | Caption = 'Standard size:' 118 | ParentColor = False 119 | end 120 | object StandardSize: TComboBox 121 | Left = 17 122 | Height = 23 123 | Top = 32 124 | Width = 245 125 | Anchors = [akTop, akLeft, akRight] 126 | DropDownCount = 9 127 | ItemHeight = 15 128 | OnChange = StandardSizeChange 129 | Style = csDropDownList 130 | TabOrder = 5 131 | end 132 | object act: TActionList 133 | left = 208 134 | top = 96 135 | object actCreate: TAction 136 | Caption = 'Create' 137 | OnExecute = actCreateExecute 138 | ShortCut = 16397 139 | end 140 | object actCancel: TAction 141 | Caption = 'Cancel' 142 | OnExecute = actCancelExecute 143 | ShortCut = 27 144 | end 145 | end 146 | end 147 | -------------------------------------------------------------------------------- /forms/new_map.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit new_map; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 25 | StdCtrls, Spin, ActnList, Map; 26 | 27 | type 28 | 29 | { TNewMapForm } 30 | 31 | TNewMapForm = class(TForm) 32 | act: TActionList; 33 | actCreate: TAction; 34 | actCancel: TAction; 35 | btOk: TButton; 36 | btCancel: TButton; 37 | cbSquare: TCheckBox; 38 | StandardSize: TComboBox; 39 | Label1: TLabel; 40 | lbWidth: TLabel; 41 | lbHeight: TLabel; 42 | lbLevels: TLabel; 43 | pnButtons: TPanel; 44 | edWidth: TSpinEdit; 45 | edHeight: TSpinEdit; 46 | edLevels: TSpinEdit; 47 | procedure actCancelExecute(Sender: TObject); 48 | procedure actCreateExecute(Sender: TObject); 49 | procedure cbSquareChange(Sender: TObject); 50 | procedure edHeightChange(Sender: TObject); 51 | procedure edWidthChange(Sender: TObject); 52 | procedure FormCreate(Sender: TObject); 53 | procedure StandardSizeChange(Sender: TObject); 54 | private 55 | procedure UpdateControls; 56 | 57 | procedure CheckStandardSize; 58 | public 59 | { public declarations } 60 | 61 | function Execute(out AParams: TMapCreateParams): boolean; 62 | end; 63 | 64 | 65 | implementation 66 | 67 | uses math; 68 | 69 | const 70 | STANDARD_SIZES : array[0..8] of Integer = 71 | ( 72 | 18, 36, 72, 108, 144, 180, 216, 252, 1008 73 | ); 74 | STANDARD_SIZES_NAMES : array[0..8] of String = 75 | ( 76 | 'Min 18x18', 77 | 'S 36x36', 78 | 'M 72x72', 79 | 'L 108x108', 80 | 'XL 144x144', 81 | 'H 180x180', 82 | 'XH 216x216', 83 | 'G 252x252', 84 | 'Max 1008x1008' 85 | ); 86 | 87 | {$R *.lfm} 88 | 89 | { TNewMapForm } 90 | 91 | procedure TNewMapForm.cbSquareChange(Sender: TObject); 92 | begin 93 | UpdateControls; 94 | end; 95 | 96 | procedure TNewMapForm.edHeightChange(Sender: TObject); 97 | begin 98 | CheckStandardSize; 99 | end; 100 | 101 | procedure TNewMapForm.actCreateExecute(Sender: TObject); 102 | begin 103 | ModalResult:=mrOK; 104 | end; 105 | 106 | procedure TNewMapForm.actCancelExecute(Sender: TObject); 107 | begin 108 | ModalResult:=mrCancel; 109 | end; 110 | 111 | procedure TNewMapForm.edWidthChange(Sender: TObject); 112 | begin 113 | if cbSquare.Checked then 114 | begin 115 | edHeight.Value := edWidth.Value; 116 | end 117 | else 118 | begin 119 | CheckStandardSize; 120 | end; 121 | end; 122 | 123 | procedure TNewMapForm.FormCreate(Sender: TObject); 124 | var 125 | idx: Integer; 126 | begin 127 | StandardSize.Items.Clear; 128 | 129 | for idx := Low(STANDARD_SIZES) to High(STANDARD_SIZES) do 130 | begin 131 | StandardSize.Items.Add(STANDARD_SIZES_NAMES[idx]); 132 | end; 133 | 134 | UpdateControls; 135 | end; 136 | 137 | procedure TNewMapForm.StandardSizeChange(Sender: TObject); 138 | begin 139 | if StandardSize.ItemIndex >= 0 then 140 | begin 141 | cbSquare.Checked := true; 142 | edWidth.Value:=STANDARD_SIZES[StandardSize.ItemIndex]; 143 | end; 144 | end; 145 | 146 | procedure TNewMapForm.UpdateControls; 147 | var 148 | dim: Integer; 149 | begin 150 | edHeight.Enabled := not cbSquare.Checked; 151 | 152 | if cbSquare.Checked then 153 | begin 154 | dim := Max(edWidth.Value, edHeight.Value); 155 | edWidth.Value := dim; 156 | edHeight.Value:= dim; 157 | end; 158 | end; 159 | 160 | procedure TNewMapForm.CheckStandardSize; 161 | var 162 | idx: Integer; 163 | found: Boolean; 164 | begin 165 | if edWidth.Value <> edHeight.Value then 166 | begin 167 | StandardSize.ItemIndex:=-1; 168 | Exit; 169 | end; 170 | 171 | found := false; 172 | 173 | for idx := Low(STANDARD_SIZES) to High(STANDARD_SIZES) do 174 | begin 175 | if edWidth.Value = STANDARD_SIZES[idx] then 176 | begin 177 | found := true; 178 | Break; 179 | end; 180 | end; 181 | 182 | if not found then 183 | begin 184 | StandardSize.ItemIndex:=-1; 185 | end; 186 | end; 187 | 188 | function TNewMapForm.Execute(out AParams: TMapCreateParams): boolean; 189 | begin 190 | Result := ShowModal() = mrOK; 191 | 192 | if Result then 193 | begin 194 | AParams.Height := edHeight.Value; 195 | AParams.Width := edWidth.Value; 196 | AParams.Levels := edLevels.Value; 197 | end; 198 | end; 199 | 200 | end. 201 | 202 | -------------------------------------------------------------------------------- /forms/player_options_form.lfm: -------------------------------------------------------------------------------- 1 | object PlayerOptionsForm: TPlayerOptionsForm 2 | Left = 595 3 | Height = 528 4 | Top = 143 5 | Width = 636 6 | Caption = 'Player options' 7 | ClientHeight = 528 8 | ClientWidth = 636 9 | LCLVersion = '1.4.5.0' 10 | object btOk: TButton 11 | AnchorSideRight.Control = btCancel 12 | AnchorSideBottom.Control = Owner 13 | AnchorSideBottom.Side = asrBottom 14 | Left = 460 15 | Height = 26 16 | Top = 492 17 | Width = 81 18 | Action = actSave 19 | Anchors = [akRight, akBottom] 20 | BorderSpacing.Right = 10 21 | BorderSpacing.Bottom = 10 22 | TabOrder = 1 23 | end 24 | object btCancel: TButton 25 | AnchorSideRight.Control = Owner 26 | AnchorSideRight.Side = asrBottom 27 | AnchorSideBottom.Control = Owner 28 | AnchorSideBottom.Side = asrBottom 29 | Left = 551 30 | Height = 26 31 | Top = 492 32 | Width = 75 33 | Action = actDontSave 34 | Anchors = [akRight, akBottom] 35 | BorderSpacing.Right = 10 36 | BorderSpacing.Bottom = 10 37 | TabOrder = 2 38 | end 39 | object pcMain: TPageControl 40 | AnchorSideLeft.Control = Owner 41 | AnchorSideTop.Control = Owner 42 | AnchorSideRight.Control = Owner 43 | AnchorSideRight.Side = asrBottom 44 | AnchorSideBottom.Control = Owner 45 | AnchorSideBottom.Side = asrBottom 46 | Left = 3 47 | Height = 477 48 | Top = 3 49 | Width = 630 50 | Anchors = [akTop, akLeft, akRight, akBottom] 51 | BorderSpacing.Left = 3 52 | BorderSpacing.Top = 3 53 | BorderSpacing.Right = 3 54 | BorderSpacing.Bottom = 48 55 | TabOrder = 0 56 | end 57 | object act: TActionList 58 | left = 16 59 | top = 16 60 | object actSave: TAction 61 | Caption = 'Save' 62 | OnExecute = actSaveExecute 63 | ShortCut = 16397 64 | end 65 | object actDontSave: TAction 66 | Caption = 'Don`t save' 67 | OnExecute = actDontSaveExecute 68 | ShortCut = 27 69 | end 70 | end 71 | end 72 | -------------------------------------------------------------------------------- /forms/player_options_form.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit player_options_form; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 25 | ComCtrls, ExtCtrls, ActnList, map, editor_types, player_options_frame; 26 | 27 | type 28 | 29 | { TPlayerOptionsForm } 30 | 31 | TPlayerOptionsForm = class(TForm) 32 | act: TActionList; 33 | actDontSave: TAction; 34 | actSave: TAction; 35 | btCancel: TButton; 36 | btOk: TButton; 37 | pcMain: TPageControl; 38 | procedure actDontSaveExecute(Sender: TObject); 39 | procedure actSaveExecute(Sender: TObject); 40 | private 41 | FEditors: array[TPlayerColor] of TPlayerOptionsFrame; 42 | FVirtualTeams: array[TPlayerColor] of TTeam; 43 | FTeamCache: TTeamSettings; 44 | FMap: TVCMIMap; 45 | procedure SetMap(AValue: TVCMIMap); 46 | procedure ReadData; 47 | procedure Commit; 48 | 49 | procedure UpdateTeams(Sender: TObject; APlayer: TPlayerColor; ATeam: TTeam); 50 | procedure GetVirtualTeam(APlayer: TPlayerColor; var ATeam: TTeam); 51 | public 52 | constructor Create(TheOwner: TComponent); override; 53 | destructor Destroy; override; 54 | property Map: TVCMIMap read FMap write SetMap; 55 | end; 56 | 57 | implementation 58 | 59 | {$R *.lfm} 60 | 61 | { TPlayerOptionsForm } 62 | 63 | procedure TPlayerOptionsForm.actSaveExecute(Sender: TObject); 64 | begin 65 | Commit; 66 | ModalResult:=mrOK; 67 | end; 68 | 69 | procedure TPlayerOptionsForm.actDontSaveExecute(Sender: TObject); 70 | begin 71 | ModalResult:=mrCancel; 72 | end; 73 | 74 | procedure TPlayerOptionsForm.SetMap(AValue: TVCMIMap); 75 | var 76 | Player: TPlayer; 77 | page: TTabSheet; 78 | editor: TPlayerOptionsFrame; 79 | begin 80 | if FMap=AValue then Exit; 81 | FMap:=AValue; 82 | 83 | if Assigned(FMap) then 84 | begin 85 | FTeamCache := TTeamSettings.Create(FMap); 86 | 87 | for Player in TPlayerColor do 88 | begin 89 | page := TTabSheet.Create(pcMain); 90 | page.PageControl := pcMain; 91 | page.TabVisible:=true; 92 | 93 | editor := TPlayerOptionsFrame.Create(page); 94 | editor.Visible:=true; 95 | editor.Parent:=page; 96 | editor.Align:=alClient; 97 | editor.OnGetVirtualTeam := @GetVirtualTeam; 98 | editor.OnAlliesChanged := @UpdateTeams; 99 | editor.TeamCache := FTeamCache; 100 | 101 | FEditors[Player] := editor; 102 | 103 | FVirtualTeams[Player] := TTeam.Create(nil); 104 | FVirtualTeams[Player].Include(Player); 105 | end; 106 | 107 | ReadData; 108 | end; 109 | 110 | end; 111 | 112 | procedure TPlayerOptionsForm.ReadData; 113 | var 114 | Player: TPlayer; 115 | page: TTabSheet; 116 | begin 117 | FTeamCache.Clear; 118 | FTeamCache.Assign(FMap.Teams); 119 | for Player in TPlayerColor do 120 | begin 121 | page := FEditors[Player].Parent as TTabSheet; 122 | page.Caption:=FMap.ListsManager.PlayerName[Player]; 123 | 124 | FEditors[Player].Map := FMap; 125 | FEditors[Player].EditObject(FMap.Players.GetPlayerInfo(Integer(Player))); 126 | end; 127 | end; 128 | 129 | procedure TPlayerOptionsForm.Commit; 130 | var 131 | Player: TPlayer; 132 | begin 133 | for Player in TPlayerColor do 134 | begin 135 | FEditors[Player].Commit; 136 | end; 137 | FMap.Teams.Assign(FTeamCache); 138 | end; 139 | 140 | procedure TPlayerOptionsForm.UpdateTeams(Sender: TObject; 141 | APlayer: TPlayerColor; ATeam: TTeam); 142 | var 143 | Player: TPlayer; 144 | team: TCollectionItem; 145 | new_team: TTeam; 146 | begin 147 | if not Assigned(ATeam) then 148 | begin 149 | //team set to none 150 | for team in FTeamCache do 151 | begin 152 | TTeam(team).Exclude(APlayer); 153 | end; 154 | end 155 | else 156 | if not Assigned(ATeam.Collection) then 157 | begin 158 | //team set to virtual team 159 | new_team := FTeamCache.Add; 160 | new_team.Assign(ATeam); 161 | new_team.Include(APlayer); 162 | end 163 | else 164 | begin 165 | //existing team 166 | ATeam.Include(APlayer); 167 | end; 168 | 169 | for team in FTeamCache do 170 | begin 171 | if TTeam(team).IsEmpty then team.Free; 172 | end; 173 | 174 | for Player in TPlayerColor do 175 | begin 176 | FEditors[Player].FillTeams; 177 | end; 178 | end; 179 | 180 | procedure TPlayerOptionsForm.GetVirtualTeam(APlayer: TPlayerColor; var ATeam: TTeam); 181 | begin 182 | ATeam := FVirtualTeams[APlayer]; 183 | end; 184 | 185 | constructor TPlayerOptionsForm.Create(TheOwner: TComponent); 186 | var 187 | Player: TPlayer; 188 | begin 189 | inherited Create(TheOwner); 190 | 191 | for Player in TPlayerColor do 192 | begin 193 | FVirtualTeams[Player] := nil; 194 | end; 195 | end; 196 | 197 | destructor TPlayerOptionsForm.Destroy; 198 | var 199 | Player: TPlayer; 200 | begin 201 | inherited Destroy; 202 | 203 | for Player in TPlayerColor do 204 | begin 205 | FVirtualTeams[Player].Free; 206 | end; 207 | 208 | FreeAndNil(FTeamCache); 209 | end; 210 | 211 | end. 212 | 213 | -------------------------------------------------------------------------------- /forms/player_options_frame.lfm: -------------------------------------------------------------------------------- 1 | object PlayerOptionsFrame: TPlayerOptionsFrame 2 | Left = 0 3 | Height = 363 4 | Top = 0 5 | Width = 548 6 | ChildSizing.LeftRightSpacing = 20 7 | ChildSizing.TopBottomSpacing = 10 8 | ChildSizing.HorizontalSpacing = 20 9 | ChildSizing.VerticalSpacing = 10 10 | ChildSizing.EnlargeHorizontal = crsScaleChilds 11 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize 12 | ChildSizing.ShrinkHorizontal = crsScaleChilds 13 | ChildSizing.ShrinkVertical = crsHomogenousSpaceResize 14 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 15 | ChildSizing.ControlsPerLine = 3 16 | ClientHeight = 363 17 | ClientWidth = 548 18 | TabOrder = 0 19 | DesignLeft = 864 20 | DesignTop = 196 21 | object lbCanPlay: TLabel 22 | Left = 20 23 | Height = 23 24 | Top = 22 25 | Width = 90 26 | Caption = 'Can play:' 27 | Constraints.MaxWidth = 90 28 | ParentColor = False 29 | end 30 | object edCanPlay: TComboBox 31 | Left = 150 32 | Height = 23 33 | Top = 22 34 | Width = 244 35 | Constraints.MinWidth = 200 36 | ItemHeight = 15 37 | Items.Strings = ( 38 | 'Player or AI' 39 | 'Player only' 40 | 'AI only' 41 | ) 42 | TabOrder = 0 43 | end 44 | object CanPlayDescription: TLabel 45 | Left = 414 46 | Height = 23 47 | Top = 22 48 | Width = 114 49 | ParentColor = False 50 | end 51 | object lbAllowedFactions: TLabel 52 | Left = 20 53 | Height = 100 54 | Top = 67 55 | Width = 90 56 | Caption = 'Allowed factions:' 57 | Constraints.MaxWidth = 90 58 | ParentColor = False 59 | end 60 | object edAllowedFactions: TCheckListBox 61 | Left = 150 62 | Height = 100 63 | Top = 67 64 | Width = 244 65 | ItemHeight = 0 66 | TabOrder = 1 67 | end 68 | object AllowedFactionsPermissive: TCheckBox 69 | Left = 414 70 | Height = 100 71 | Top = 67 72 | Width = 114 73 | Caption = 'Allow others' 74 | TabOrder = 5 75 | end 76 | object Label3: TLabel 77 | Left = 20 78 | Height = 19 79 | Top = 189 80 | Width = 110 81 | ParentColor = False 82 | end 83 | object edRandomFaction: TCheckBox 84 | Left = 150 85 | Height = 19 86 | Top = 189 87 | Width = 244 88 | Caption = 'Random faction' 89 | TabOrder = 7 90 | end 91 | object Label4: TLabel 92 | Left = 414 93 | Height = 19 94 | Top = 189 95 | Width = 114 96 | ParentColor = False 97 | end 98 | object lbMainTown: TLabel 99 | Left = 20 100 | Height = 23 101 | Top = 230 102 | Width = 90 103 | AutoSize = False 104 | Caption = 'Main town:' 105 | Constraints.MaxWidth = 90 106 | ParentColor = False 107 | end 108 | object edMainTown: TComboBox 109 | Left = 150 110 | Height = 23 111 | Top = 230 112 | Width = 244 113 | ItemHeight = 15 114 | Style = csDropDownList 115 | TabOrder = 2 116 | end 117 | object edGenerateHero: TCheckBox 118 | Left = 414 119 | Height = 23 120 | Top = 230 121 | Width = 114 122 | Caption = 'Generate hero' 123 | TabOrder = 6 124 | end 125 | object lbMainHero: TLabel 126 | Left = 20 127 | Height = 23 128 | Top = 275 129 | Width = 90 130 | AutoSize = False 131 | Caption = 'Main hero:' 132 | Constraints.MaxWidth = 90 133 | ParentColor = False 134 | end 135 | object edMainHero: TComboBox 136 | Left = 150 137 | Height = 23 138 | Top = 275 139 | Width = 244 140 | ItemHeight = 15 141 | Style = csDropDownList 142 | TabOrder = 3 143 | end 144 | object Label1: TLabel 145 | Left = 414 146 | Height = 23 147 | Top = 275 148 | Width = 114 149 | ParentColor = False 150 | end 151 | object lbTeam: TLabel 152 | Left = 20 153 | Height = 23 154 | Top = 320 155 | Width = 90 156 | AutoSize = False 157 | Caption = 'Allies:' 158 | Constraints.MaxWidth = 90 159 | ParentColor = False 160 | end 161 | object edTeam: TComboBox 162 | Left = 150 163 | Height = 23 164 | Top = 320 165 | Width = 244 166 | ItemHeight = 15 167 | Style = csDropDownList 168 | TabOrder = 4 169 | end 170 | object Label2: TLabel 171 | Left = 414 172 | Height = 23 173 | Top = 320 174 | Width = 114 175 | ParentColor = False 176 | end 177 | end 178 | -------------------------------------------------------------------------------- /forms/player_selection_form.lfm: -------------------------------------------------------------------------------- 1 | object PlayerSelectionForm: TPlayerSelectionForm 2 | Left = 543 3 | Height = 370 4 | Top = 243 5 | Width = 327 6 | Caption = 'Select owner' 7 | ClientHeight = 370 8 | ClientWidth = 327 9 | Constraints.MinHeight = 250 10 | Constraints.MinWidth = 250 11 | LCLVersion = '1.6.1.0' 12 | object edOwnerRG: TRadioGroup 13 | Left = 15 14 | Height = 308 15 | Top = 8 16 | Width = 296 17 | Anchors = [akTop, akLeft, akRight, akBottom] 18 | AutoFill = True 19 | Caption = 'Owner:' 20 | ChildSizing.LeftRightSpacing = 6 21 | ChildSizing.TopBottomSpacing = 6 22 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 23 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 24 | ChildSizing.ShrinkHorizontal = crsScaleChilds 25 | ChildSizing.ShrinkVertical = crsScaleChilds 26 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 27 | ChildSizing.ControlsPerLine = 1 28 | TabOrder = 0 29 | end 30 | object btOk: TButton 31 | Left = 160 32 | Height = 25 33 | Top = 332 34 | Width = 75 35 | Action = actSave 36 | Anchors = [akRight, akBottom] 37 | ModalResult = 1 38 | TabOrder = 1 39 | end 40 | object btCancel: TButton 41 | Left = 240 42 | Height = 25 43 | Top = 332 44 | Width = 75 45 | Action = actDontSave 46 | Anchors = [akRight, akBottom] 47 | ModalResult = 2 48 | TabOrder = 2 49 | end 50 | object act: TActionList 51 | left = 24 52 | top = 32 53 | object actSave: TAction 54 | Caption = 'OK' 55 | OnExecute = actSaveExecute 56 | ShortCut = 16397 57 | end 58 | object actDontSave: TAction 59 | Caption = 'Cancel' 60 | OnExecute = actDontSaveExecute 61 | ShortCut = 27 62 | end 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /forms/player_selection_form.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit player_selection_form; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 26 | StdCtrls, ActnList, root_manager, lists_manager, editor_types; 27 | 28 | type 29 | 30 | { TPlayerSelectionForm } 31 | 32 | TPlayerSelectionForm = class(TForm) 33 | act: TActionList; 34 | actDontSave: TAction; 35 | actSave: TAction; 36 | btCancel: TButton; 37 | btOk: TButton; 38 | edOwnerRG: TRadioGroup; 39 | procedure actDontSaveExecute(Sender: TObject); 40 | procedure actSaveExecute(Sender: TObject); 41 | private 42 | { private declarations } 43 | public 44 | constructor Create(TheOwner: TComponent); override; 45 | 46 | function SelectedPlayer:TPlayer; 47 | end; 48 | 49 | 50 | implementation 51 | 52 | {$R *.lfm} 53 | 54 | { TPlayerSelectionForm } 55 | 56 | procedure TPlayerSelectionForm.actSaveExecute(Sender: TObject); 57 | begin 58 | ModalResult:=mrOK; 59 | end; 60 | 61 | procedure TPlayerSelectionForm.actDontSaveExecute(Sender: TObject); 62 | begin 63 | ModalResult:=mrCancel; 64 | end; 65 | 66 | constructor TPlayerSelectionForm.Create(TheOwner: TComponent); 67 | begin 68 | inherited Create(TheOwner); 69 | 70 | RootManager.ListsManager.FillWithPlayers(edOwnerRG.Items, False); 71 | edOwnerRG.ItemIndex := 0; 72 | end; 73 | 74 | function TPlayerSelectionForm.SelectedPlayer: TPlayer; 75 | begin 76 | Result := TPlayer(edOwnerRG.ItemIndex); 77 | end; 78 | 79 | end. 80 | 81 | -------------------------------------------------------------------------------- /forms/position.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit position; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | SysUtils, fpjson, vcmi_json; 26 | 27 | type 28 | { TPosition } 29 | 30 | TPosition = class(TObject, ISerializeSpecial) 31 | private 32 | FL: Integer; 33 | FX: Integer; 34 | FY: Integer; 35 | procedure SetL(AValue: Integer); 36 | procedure SetX(AValue: Integer); 37 | procedure SetY(AValue: Integer); 38 | public 39 | constructor Create; 40 | function Serialize(AHandler: TVCMIJSONStreamer): TJSONData; 41 | procedure Deserialize(AHandler: TVCMIJSONDestreamer; ASrc: TJSONData); 42 | 43 | procedure Assign(AOther: TPosition); 44 | function Equals(Obj: TPosition): boolean; reintroduce; 45 | 46 | property X: Integer read FX write SetX; 47 | property Y: Integer read FY write SetY; 48 | property L: Integer read FL write SetL; 49 | 50 | function IsEmpty: Boolean; 51 | end; 52 | 53 | implementation 54 | 55 | { TPosition } 56 | 57 | procedure TPosition.SetL(AValue: Integer); 58 | begin 59 | if FL=AValue then Exit; 60 | FL:=AValue; 61 | end; 62 | 63 | procedure TPosition.SetX(AValue: Integer); 64 | begin 65 | if FX=AValue then Exit; 66 | FX:=AValue; 67 | end; 68 | 69 | procedure TPosition.SetY(AValue: Integer); 70 | begin 71 | if FY=AValue then Exit; 72 | FY:=AValue; 73 | end; 74 | 75 | constructor TPosition.Create; 76 | begin 77 | FX := -1; 78 | FY := -1; 79 | FL := -1; 80 | end; 81 | 82 | function TPosition.Serialize(AHandler: TVCMIJSONStreamer): TJSONData; 83 | begin 84 | result := CreateJSONArray([X,Y,L]); 85 | end; 86 | 87 | procedure TPosition.Deserialize(AHandler: TVCMIJSONDestreamer; ASrc: TJSONData); 88 | var 89 | src_array: TJSONArray; 90 | begin 91 | src_array := TJSONArray(ASrc); 92 | X := src_array.Integers[0]; 93 | Y := src_array.Integers[1]; 94 | L := src_array.Integers[2]; 95 | end; 96 | 97 | procedure TPosition.Assign(AOther: TPosition); 98 | begin 99 | X:=AOther.X; 100 | Y:=AOther.Y; 101 | L:=AOther.L; 102 | end; 103 | 104 | function TPosition.Equals(Obj: TPosition): boolean; 105 | begin 106 | Result := (Obj.X = X) and (Obj.Y = Y) and (Obj.L = L); 107 | end; 108 | 109 | function TPosition.IsEmpty: Boolean; 110 | begin 111 | Result := (X<0) or (Y<0) or (L<0); 112 | end; 113 | 114 | end. 115 | 116 | -------------------------------------------------------------------------------- /forms/resource_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited ResourceFrame: TResourceFrame 2 | Height = 316 3 | Width = 415 4 | ClientHeight = 316 5 | ClientWidth = 415 6 | object GroupAmount: TGroupBox[0] 7 | Left = 8 8 | Height = 56 9 | Top = 8 10 | Width = 400 11 | Anchors = [akTop, akLeft, akRight] 12 | Caption = 'Amount:' 13 | ClientHeight = 36 14 | ClientWidth = 396 15 | TabOrder = 0 16 | object cbRandom: TCheckBox 17 | Left = 322 18 | Height = 19 19 | Top = 8 20 | Width = 62 21 | Anchors = [akTop, akRight] 22 | Caption = 'Custom' 23 | TabOrder = 0 24 | end 25 | object edAmount: TSpinEdit 26 | Left = 8 27 | Height = 23 28 | Top = 8 29 | Width = 289 30 | Anchors = [akTop, akLeft, akRight] 31 | MaxValue = 1000000000 32 | TabOrder = 1 33 | end 34 | end 35 | object GroupMessage: TGroupBox[1] 36 | Left = 8 37 | Height = 234 38 | Top = 72 39 | Width = 401 40 | Anchors = [akTop, akLeft, akRight, akBottom] 41 | Caption = 'Message:' 42 | ClientHeight = 214 43 | ClientWidth = 397 44 | TabOrder = 1 45 | object edMessage: TMemo 46 | Left = 5 47 | Height = 204 48 | Top = 5 49 | Width = 387 50 | Align = alClient 51 | BorderSpacing.Around = 5 52 | TabOrder = 0 53 | end 54 | end 55 | end 56 | -------------------------------------------------------------------------------- /forms/resource_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit resource_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 25 | Spin, base_options_frame, object_options; 26 | 27 | type 28 | 29 | { TResourceFrame } 30 | 31 | TResourceFrame = class(TBaseOptionsFrame) 32 | cbRandom: TCheckBox; 33 | GroupAmount: TGroupBox; 34 | edAmount: TSpinEdit; 35 | GroupMessage: TGroupBox; 36 | edMessage: TMemo; 37 | private 38 | FOptions: TResourceOptions; 39 | protected 40 | public 41 | procedure Commit; override; 42 | procedure VisitResource(AOptions: TResourceOptions); override; 43 | end; 44 | 45 | implementation 46 | 47 | {$R *.lfm} 48 | 49 | { TResourceFrame } 50 | 51 | 52 | procedure TResourceFrame.Commit; 53 | begin 54 | inherited Commit; 55 | FOptions.GuardMessage := edMessage.Text; 56 | end; 57 | 58 | procedure TResourceFrame.VisitResource(AOptions: TResourceOptions); 59 | begin 60 | FOptions := AOptions; 61 | 62 | AddIntEditor(AOptions, 'Amount', edAmount, cbRandom); 63 | 64 | inherited VisitResource(AOptions); 65 | 66 | edMessage.Text:=AOptions.GuardMessage; 67 | 68 | Load; 69 | 70 | UpdateControls; 71 | end; 72 | 73 | end. 74 | 75 | -------------------------------------------------------------------------------- /forms/scholar_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited ScholarFrame: TScholarFrame 2 | Height = 164 3 | Width = 423 4 | ClientHeight = 164 5 | ClientWidth = 423 6 | object edBonusType: TRadioGroup[0] 7 | Left = 16 8 | Height = 49 9 | Top = 16 10 | Width = 389 11 | Anchors = [akTop, akLeft, akRight] 12 | AutoFill = True 13 | Caption = 'Bonus type:' 14 | ChildSizing.LeftRightSpacing = 6 15 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 16 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 17 | ChildSizing.ShrinkHorizontal = crsScaleChilds 18 | ChildSizing.ShrinkVertical = crsScaleChilds 19 | ChildSizing.Layout = cclTopToBottomThenLeftToRight 20 | ChildSizing.ControlsPerLine = 1 21 | ClientHeight = 29 22 | ClientWidth = 385 23 | ColumnLayout = clVerticalThenHorizontal 24 | Columns = 4 25 | Items.Strings = ( 26 | 'Primary skill' 27 | 'Secondary skill ' 28 | 'Spell' 29 | 'Random' 30 | ) 31 | OnClick = edBonusTypeClick 32 | TabOrder = 0 33 | end 34 | object edBonusID: TComboBox[1] 35 | Left = 16 36 | Height = 23 37 | Top = 96 38 | Width = 386 39 | Anchors = [akTop, akLeft, akRight] 40 | AutoDropDown = True 41 | ItemHeight = 15 42 | OnChange = edBonusIDChange 43 | Style = csDropDownList 44 | TabOrder = 1 45 | end 46 | object Label1: TLabel[2] 47 | Left = 16 48 | Height = 15 49 | Top = 72 50 | Width = 50 51 | Caption = 'Bonus ID:' 52 | ParentColor = False 53 | end 54 | end 55 | -------------------------------------------------------------------------------- /forms/scholar_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit scholar_frame; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 26 | StdCtrls, base_options_frame, gui_helpers, object_options, 27 | editor_types, editor_consts, lists_manager, base_info; 28 | 29 | type 30 | 31 | { TScholarFrame } 32 | 33 | TScholarFrame = class(TBaseOptionsFrame) 34 | edBonusID: TComboBox; 35 | edBonusType: TRadioGroup; 36 | Label1: TLabel; 37 | procedure edBonusIDChange(Sender: TObject); 38 | procedure edBonusTypeClick(Sender: TObject); 39 | private 40 | FOptions: TScholarOptions; 41 | FBonusID: AnsiString; 42 | 43 | protected 44 | procedure UpdateControls; override; 45 | public 46 | procedure Commit; override; 47 | procedure VisitScholar(AOptions: TScholarOptions); override; 48 | end; 49 | 50 | implementation 51 | 52 | {$R *.lfm} 53 | 54 | { TScholarFrame } 55 | 56 | procedure TScholarFrame.edBonusTypeClick(Sender: TObject); 57 | begin 58 | FBonusID := ''; 59 | UpdateControls; 60 | end; 61 | 62 | procedure TScholarFrame.edBonusIDChange(Sender: TObject); 63 | begin 64 | FBonusID:=''; 65 | 66 | if edBonusID.ItemIndex<>-1 then 67 | begin 68 | FBonusID:=(edBonusID.Items.Objects[edBonusID.ItemIndex] as TBaseInfo).Identifier; 69 | end; 70 | end; 71 | 72 | procedure TScholarFrame.UpdateControls; 73 | var 74 | tmp : AnsiString; 75 | begin 76 | inherited UpdateControls; 77 | tmp := FBonusID; 78 | 79 | edBonusID.Enabled := edBonusType.ItemIndex <> Integer(TScholarBonus.random); 80 | 81 | edBonusID.Items.Clear; 82 | edBonusID.ItemIndex := -1; 83 | 84 | 85 | FBonusID := tmp; 86 | 87 | case edBonusType.ItemIndex of 88 | Integer(TScholarBonus.random): 89 | begin 90 | 91 | end; 92 | Integer(TScholarBonus.primSkill): 93 | begin 94 | edBonusID.FillFromList(ListsManager.PrimarySkills, FBonusID); 95 | end; 96 | Integer(TScholarBonus.skill): 97 | begin 98 | edBonusID.FillFromList(ListsManager.SkillInfos, FBonusID); 99 | end; 100 | Integer(TScholarBonus.spell): 101 | begin 102 | edBonusID.FillFromList(ListsManager.SpellInfos, FBonusID); 103 | end; 104 | end; 105 | 106 | if (edBonusID.Items.Count > 0) and (edBonusID.ItemIndex = -1) then 107 | begin 108 | edBonusID.ItemIndex := 0; 109 | end; 110 | end; 111 | 112 | procedure TScholarFrame.Commit; 113 | begin 114 | FOptions.Clear; 115 | case TScholarBonus(edBonusType.ItemIndex) of 116 | TScholarBonus.primSkill: FOptions.RewardPrimSkill := FBonusID; 117 | TScholarBonus.skill: FOptions.RewardSkill := FBonusID; 118 | TScholarBonus.spell: FOptions.RewardSpell := FBonusID; 119 | end; 120 | end; 121 | 122 | procedure TScholarFrame.VisitScholar(AOptions: TScholarOptions); 123 | begin 124 | FOptions := AOptions; 125 | 126 | FBonusID := ''; 127 | 128 | if AOptions.RewardPrimSkill <> '' then 129 | begin 130 | edBonusType.ItemIndex:=Integer(TScholarBonus.primSkill); 131 | FBonusID:=AOptions.RewardPrimSkill; 132 | end 133 | else if AOptions.RewardSkill <> '' then 134 | begin 135 | edBonusType.ItemIndex:=Integer(TScholarBonus.skill); 136 | FBonusID:=AOptions.RewardSkill; 137 | end 138 | else if AOptions.RewardSpell <> '' then 139 | begin 140 | edBonusType.ItemIndex:=Integer(TScholarBonus.spell); 141 | FBonusID:=AOptions.RewardSpell; 142 | end 143 | else 144 | edBonusType.ItemIndex := Integer(TScholarBonus.random); 145 | 146 | UpdateControls; 147 | end; 148 | 149 | end. 150 | 151 | -------------------------------------------------------------------------------- /forms/shrine_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited ShrineFrame: TShrineFrame 2 | object GroupBox1: TGroupBox[0] 3 | Left = 0 4 | Height = 49 5 | Top = 0 6 | Width = 320 7 | Align = alTop 8 | AutoSize = True 9 | ChildSizing.LeftRightSpacing = 5 10 | ChildSizing.TopBottomSpacing = 5 11 | ChildSizing.HorizontalSpacing = 5 12 | ChildSizing.Layout = cclTopToBottomThenLeftToRight 13 | ChildSizing.ControlsPerLine = 1 14 | ClientHeight = 29 15 | ClientWidth = 316 16 | TabOrder = 0 17 | object rbRandom: TRadioButton 18 | Left = 5 19 | Height = 19 20 | Top = 5 21 | Width = 65 22 | Caption = 'Random' 23 | OnChange = rbRandomChange 24 | TabOrder = 0 25 | end 26 | object rbSpecified: TRadioButton 27 | Left = 75 28 | Height = 19 29 | Top = 5 30 | Width = 68 31 | Caption = 'Specified' 32 | OnChange = rbRandomChange 33 | TabOrder = 1 34 | end 35 | end 36 | object edSpell: TListBox[1] 37 | Left = 5 38 | Height = 181 39 | Top = 54 40 | Width = 310 41 | Align = alClient 42 | BorderSpacing.Around = 5 43 | Columns = 2 44 | ItemHeight = 0 45 | TabOrder = 1 46 | end 47 | end 48 | -------------------------------------------------------------------------------- /forms/shrine_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit shrine_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 25 | gui_helpers, lists_manager, 26 | base_options_frame, object_options, base_info; 27 | 28 | type 29 | 30 | { TShrineFrame } 31 | 32 | TShrineFrame = class(TBaseOptionsFrame) 33 | GroupBox1: TGroupBox; 34 | edSpell: TListBox; 35 | rbRandom: TRadioButton; 36 | rbSpecified: TRadioButton; 37 | procedure rbRandomChange(Sender: TObject); 38 | strict private 39 | FObject: TShrineOptions; 40 | protected 41 | procedure UpdateControls; override; 42 | public 43 | procedure Commit; override; 44 | procedure VisitShrine(AOptions: TShrineOptions); override; 45 | end; 46 | 47 | implementation 48 | 49 | {$R *.lfm} 50 | 51 | { TShrineFrame } 52 | 53 | procedure TShrineFrame.Commit; 54 | begin 55 | inherited Commit; 56 | 57 | if rbRandom.Checked then 58 | begin 59 | FObject.Spell := ''; 60 | end 61 | else 62 | begin 63 | FObject.Spell := edSpell.SelectedIdentifier; 64 | end; 65 | end; 66 | 67 | procedure TShrineFrame.rbRandomChange(Sender: TObject); 68 | begin 69 | UpdateControls; 70 | end; 71 | 72 | procedure TShrineFrame.UpdateControls; 73 | begin 74 | inherited UpdateControls; 75 | edSpell.Enabled := rbSpecified.Checked; 76 | 77 | if (edSpell.ItemIndex < 0) and (edSpell.Items.Count > 0) then 78 | edSpell.ItemIndex := 0; 79 | end; 80 | 81 | procedure TShrineFrame.VisitShrine(AOptions: TShrineOptions); 82 | 83 | function spell_filter(ATarget:TBaseInfo ): Boolean; 84 | begin 85 | Result := TSpellInfo(ATarget).Level = AOptions.SpellLevel; 86 | end; 87 | 88 | begin 89 | inherited VisitShrine(AOptions); 90 | FObject := AOptions; 91 | 92 | rbRandom.Checked := FObject.Spell = ''; 93 | rbSpecified.Checked := not rbRandom.Checked; 94 | 95 | 96 | edSpell.FillFromList(ListsManager.SpellInfos, FObject.Spell, @spell_filter); 97 | 98 | UpdateControls(); 99 | 100 | end; 101 | 102 | end. 103 | 104 | -------------------------------------------------------------------------------- /forms/spellscroll_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited SpellScrollFrame: TSpellScrollFrame 2 | Height = 285 3 | Width = 404 4 | ClientHeight = 285 5 | ClientWidth = 404 6 | object edSpell: TListBox[0] 7 | Left = 0 8 | Height = 181 9 | Top = 104 10 | Width = 404 11 | Align = alClient 12 | Columns = 2 13 | ItemHeight = 0 14 | TabOrder = 0 15 | end 16 | object pnMessage: TPanel[1] 17 | AnchorSideBottom.Side = asrBottom 18 | Left = 0 19 | Height = 104 20 | Top = 0 21 | Width = 404 22 | Align = alTop 23 | Anchors = [akLeft, akRight] 24 | BevelOuter = bvNone 25 | ClientHeight = 104 26 | ClientWidth = 404 27 | TabOrder = 1 28 | object Label1: TLabel 29 | Left = 8 30 | Height = 15 31 | Top = 2 32 | Width = 49 33 | Caption = 'Message:' 34 | ParentColor = False 35 | end 36 | object edMessage: TMemo 37 | Left = 8 38 | Height = 74 39 | Top = 24 40 | Width = 390 41 | Anchors = [akTop, akLeft, akRight] 42 | TabOrder = 0 43 | end 44 | end 45 | end 46 | -------------------------------------------------------------------------------- /forms/spellscroll_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 20132017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit spellscroll_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 25 | ExtCtrls, object_options, gui_helpers, lists_manager, 26 | base_options_frame; 27 | 28 | type 29 | 30 | { TSpellScrollFrame } 31 | 32 | TSpellScrollFrame = class(TBaseOptionsFrame) 33 | edSpell: TListBox; 34 | Label1: TLabel; 35 | edMessage: TMemo; 36 | pnMessage: TPanel; 37 | private 38 | FObject: TSpellScrollOptions; 39 | public 40 | procedure VisitSpellScroll(AOptions: TSpellScrollOptions); override; 41 | procedure Commit; override; 42 | end; 43 | 44 | implementation 45 | 46 | {$R *.lfm} 47 | 48 | { TSpellScrollFrame } 49 | 50 | procedure TSpellScrollFrame.Commit; 51 | begin 52 | inherited Commit; 53 | FObject.Spell := edSpell.SelectedIdentifier; 54 | FObject.GuardMessage:=edMessage.Text; 55 | end; 56 | 57 | procedure TSpellScrollFrame.VisitSpellScroll(AOptions: TSpellScrollOptions); 58 | begin 59 | inherited VisitSpellScroll(AOptions); 60 | FObject := AOptions; 61 | 62 | edSpell.FillFromList(ListsManager.SpellInfos,FObject.Spell); 63 | 64 | edMessage.Text:=FObject.GuardMessage; 65 | end; 66 | 67 | end. 68 | 69 | -------------------------------------------------------------------------------- /forms/subframes/object_link_frame.lfm: -------------------------------------------------------------------------------- 1 | object ObjectLinkFrame: TObjectLinkFrame 2 | Left = 0 3 | Height = 240 4 | Top = 0 5 | Width = 320 6 | ClientHeight = 240 7 | ClientWidth = 320 8 | TabOrder = 0 9 | object ObjectList: TListBox 10 | Left = 0 11 | Height = 240 12 | Top = 0 13 | Width = 320 14 | Align = alClient 15 | Columns = 2 16 | ItemHeight = 0 17 | TabOrder = 0 18 | end 19 | end 20 | -------------------------------------------------------------------------------- /forms/subframes/object_link_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit object_link_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, StdCtrls, map, 25 | object_options; 26 | 27 | type 28 | 29 | { TObjectLinkFrame } 30 | 31 | TObjectLinkFrame = class(TFrame) 32 | ObjectList: TListBox; 33 | private 34 | FMap: TVCMIMap; 35 | FTypeFilter: TObjectOptionsClass; 36 | procedure SetMap(AValue: TVCMIMap); 37 | procedure SetTypeFilter(AValue: TObjectOptionsClass); 38 | public 39 | function SelectedObject: TMapObject; 40 | function SelectedIdentifier: AnsiString; 41 | procedure Load(AIdentifier: String); 42 | 43 | property Map: TVCMIMap read FMap write SetMap; 44 | 45 | property TypeFilter: TObjectOptionsClass read FTypeFilter write SetTypeFilter; 46 | end; 47 | 48 | implementation 49 | 50 | uses editor_consts; 51 | 52 | {$R *.lfm} 53 | 54 | { TObjectLinkFrame } 55 | 56 | procedure TObjectLinkFrame.SetMap(AValue: TVCMIMap); 57 | begin 58 | FMap:=AValue; 59 | end; 60 | 61 | procedure TObjectLinkFrame.SetTypeFilter(AValue: TObjectOptionsClass); 62 | begin 63 | FTypeFilter:=AValue; 64 | end; 65 | 66 | function TObjectLinkFrame.SelectedObject: TMapObject; 67 | begin 68 | if ObjectList.ItemIndex < 0 then 69 | begin 70 | Result := nil; 71 | end 72 | else begin 73 | Result := (ObjectList.Items.Objects[ObjectList.ItemIndex] as TMapObject); 74 | end; 75 | end; 76 | 77 | function TObjectLinkFrame.SelectedIdentifier: AnsiString; 78 | var 79 | o: TMapObject; 80 | begin 81 | o := SelectedObject; 82 | if Assigned(o) then 83 | Result := o.Identifier 84 | else 85 | Result := ''; 86 | end; 87 | 88 | procedure TObjectLinkFrame.Load(AIdentifier: String); 89 | var 90 | map_object: TMapObject; 91 | item: TCollectionItem; 92 | begin 93 | for item in FMap.Objects do 94 | begin 95 | map_object := TMapObject(item); 96 | 97 | if map_object.Options is FTypeFilter then 98 | ObjectList.AddItem(map_object.DisplayName, map_object) 99 | else 100 | Continue; 101 | 102 | if (AIdentifier <> '') and (map_object.Identifier = AIdentifier) then 103 | ObjectList.ItemIndex := ObjectList.Count-1; //select recently added object 104 | end; 105 | 106 | //ObjectList.Invalidate; 107 | end; 108 | 109 | end. 110 | 111 | -------------------------------------------------------------------------------- /forms/town_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited TownOptionsFrame: TTownOptionsFrame 2 | Height = 303 3 | Width = 465 4 | ChildSizing.LeftRightSpacing = 5 5 | ChildSizing.TopBottomSpacing = 3 6 | ChildSizing.HorizontalSpacing = 5 7 | ChildSizing.VerticalSpacing = 3 8 | ChildSizing.EnlargeHorizontal = crsScaleChilds 9 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize 10 | ChildSizing.ShrinkHorizontal = crsScaleChilds 11 | ChildSizing.ShrinkVertical = crsHomogenousSpaceResize 12 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 13 | ChildSizing.ControlsPerLine = 3 14 | ClientHeight = 303 15 | ClientWidth = 465 16 | object TypLabel: TLabel[0] 17 | Left = 5 18 | Height = 15 19 | Top = 63 20 | Width = 88 21 | Caption = 'Type:' 22 | ParentColor = False 23 | end 24 | object Typ: TLabel[1] 25 | Left = 98 26 | Height = 15 27 | Top = 63 28 | Width = 183 29 | ParentColor = False 30 | end 31 | object TypPlaceholder: TLabel[2] 32 | Left = 286 33 | Height = 15 34 | Top = 63 35 | Width = 174 36 | ParentColor = False 37 | end 38 | object OwnerLabel: TLabel[3] 39 | Left = 5 40 | Height = 15 41 | Top = 141 42 | Width = 88 43 | Caption = 'Owner:' 44 | ParentColor = False 45 | end 46 | object edOwner: TRadioGroup[4] 47 | Left = 98 48 | Height = 15 49 | Top = 141 50 | Width = 183 51 | AutoFill = True 52 | ChildSizing.LeftRightSpacing = 6 53 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 54 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 55 | ChildSizing.ShrinkHorizontal = crsScaleChilds 56 | ChildSizing.ShrinkVertical = crsScaleChilds 57 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 58 | ChildSizing.ControlsPerLine = 1 59 | TabOrder = 2 60 | end 61 | object OwnerPlaceholder: TLabel[5] 62 | Left = 286 63 | Height = 15 64 | Top = 141 65 | Width = 174 66 | ParentColor = False 67 | end 68 | object NameLabel: TLabel[6] 69 | Left = 5 70 | Height = 23 71 | Top = 219 72 | Width = 88 73 | Caption = 'Name:' 74 | ParentColor = False 75 | end 76 | object edName: TEdit[7] 77 | Left = 98 78 | Height = 23 79 | Top = 219 80 | Width = 183 81 | TabOrder = 0 82 | end 83 | object NameCustomise: TCheckBox[8] 84 | Left = 286 85 | Height = 23 86 | Top = 219 87 | Width = 174 88 | Caption = 'Customise' 89 | TabOrder = 1 90 | end 91 | end 92 | -------------------------------------------------------------------------------- /forms/town_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2015-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit town_frame; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 25 | ExtCtrls, base_options_frame, object_options, editor_types; 26 | 27 | type 28 | 29 | { TTownOptionsFrame } 30 | 31 | TTownOptionsFrame = class(TBaseOptionsFrame) 32 | NameCustomise: TCheckBox; 33 | edName: TEdit; 34 | NameLabel: TLabel; 35 | OwnerPlaceholder: TLabel; 36 | OwnerLabel: TLabel; 37 | edOwner: TRadioGroup; 38 | TypLabel: TLabel; 39 | Typ: TLabel; 40 | TypPlaceholder: TLabel; 41 | private 42 | FObject: TTownOptions; 43 | protected 44 | procedure Load; override; 45 | procedure UpdateControls; override; 46 | public 47 | procedure Commit; override; 48 | procedure VisitTown(AOptions: TTownOptions); override; 49 | end; 50 | 51 | implementation 52 | 53 | {$R *.lfm} 54 | 55 | { TTownOptionsFrame } 56 | 57 | procedure TTownOptionsFrame.Load; 58 | begin 59 | inherited Load; 60 | ReadOwner(FObject, edOwner); 61 | end; 62 | 63 | procedure TTownOptionsFrame.UpdateControls; 64 | begin 65 | inherited UpdateControls; 66 | end; 67 | 68 | procedure TTownOptionsFrame.Commit; 69 | begin 70 | inherited Commit; 71 | WriteOwner(FObject, edOwner); 72 | end; 73 | 74 | procedure TTownOptionsFrame.VisitTown(AOptions: TTownOptions); 75 | begin 76 | ListsManager.FillWithPlayers(edOwner.Items, True); 77 | AddStrEditor(AOptions, 'Name', edName, NameCustomise); 78 | inherited VisitTown(AOptions); 79 | FObject:=AOptions; 80 | Load; 81 | end; 82 | 83 | end. 84 | 85 | -------------------------------------------------------------------------------- /forms/town_spells_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited TownSpellsFrame: TTownSpellsFrame 2 | Height = 453 3 | Width = 665 4 | ClientHeight = 453 5 | ClientWidth = 665 6 | DesignLeft = 455 7 | DesignTop = 201 8 | object pnRight: TPanel[0] 9 | Left = 0 10 | Height = 453 11 | Top = 0 12 | Width = 267 13 | Align = alLeft 14 | BevelOuter = bvNone 15 | ClientHeight = 453 16 | ClientWidth = 267 17 | TabOrder = 0 18 | object AllSpells: TListBox 19 | Left = 3 20 | Height = 421 21 | Top = 29 22 | Width = 261 23 | Align = alClient 24 | BorderSpacing.Around = 3 25 | Columns = 2 26 | ItemHeight = 0 27 | MultiSelect = True 28 | TabOrder = 0 29 | end 30 | object cbLevel: TComboBox 31 | Left = 3 32 | Height = 23 33 | Top = 3 34 | Width = 261 35 | Align = alTop 36 | BorderSpacing.Around = 3 37 | ItemHeight = 15 38 | OnChange = cbLevelChange 39 | Style = csDropDownList 40 | TabOrder = 1 41 | end 42 | end 43 | object Splitter1: TSplitter[1] 44 | Left = 267 45 | Height = 453 46 | Top = 0 47 | Width = 5 48 | end 49 | object pnLeft: TPanel[2] 50 | Left = 272 51 | Height = 453 52 | Top = 0 53 | Width = 393 54 | Align = alClient 55 | ClientHeight = 453 56 | ClientWidth = 393 57 | TabOrder = 2 58 | object pnPossible: TPanel 59 | Left = 1 60 | Height = 242 61 | Top = 1 62 | Width = 391 63 | Align = alTop 64 | BevelOuter = bvNone 65 | ClientHeight = 242 66 | ClientWidth = 391 67 | TabOrder = 0 68 | object Possible: TListBox 69 | Left = 20 70 | Height = 212 71 | Top = 30 72 | Width = 368 73 | Align = alClient 74 | BorderSpacing.Left = 20 75 | BorderSpacing.Top = 30 76 | BorderSpacing.Right = 3 77 | Columns = 2 78 | ItemHeight = 0 79 | MultiSelect = True 80 | TabOrder = 0 81 | end 82 | object SpeedButton1: TSpeedButton 83 | Left = 0 84 | Height = 32 85 | Top = 30 86 | Width = 16 87 | Action = AddAllowed 88 | end 89 | object SpeedButton2: TSpeedButton 90 | Left = 0 91 | Height = 32 92 | Top = 72 93 | Width = 16 94 | Action = RemoveAllowed 95 | end 96 | object lbPossible: TLabel 97 | Left = 32 98 | Height = 15 99 | Top = 8 100 | Width = 75 101 | Caption = 'Allowed spells' 102 | ParentColor = False 103 | end 104 | end 105 | object Splitter2: TSplitter 106 | Cursor = crVSplit 107 | Left = 1 108 | Height = 5 109 | Top = 243 110 | Width = 391 111 | Align = alTop 112 | ResizeAnchor = akTop 113 | end 114 | object pnObligatory: TPanel 115 | Left = 1 116 | Height = 204 117 | Top = 248 118 | Width = 391 119 | Align = alClient 120 | BevelOuter = bvNone 121 | ClientHeight = 204 122 | ClientWidth = 391 123 | TabOrder = 2 124 | object Obligatory: TListBox 125 | Left = 20 126 | Height = 171 127 | Top = 30 128 | Width = 368 129 | Align = alClient 130 | BorderSpacing.Left = 20 131 | BorderSpacing.Top = 30 132 | BorderSpacing.Right = 3 133 | BorderSpacing.Bottom = 3 134 | Columns = 2 135 | ItemHeight = 0 136 | MultiSelect = True 137 | TabOrder = 0 138 | end 139 | object SpeedButton4: TSpeedButton 140 | Left = 0 141 | Height = 32 142 | Top = 72 143 | Width = 16 144 | Action = RemoveRequired 145 | end 146 | object SpeedButton5: TSpeedButton 147 | Left = 0 148 | Height = 32 149 | Top = 32 150 | Width = 16 151 | Action = AddRequired 152 | end 153 | object lbPossible1: TLabel 154 | Left = 32 155 | Height = 15 156 | Top = 8 157 | Width = 79 158 | Caption = 'Required spells' 159 | ParentColor = False 160 | end 161 | end 162 | end 163 | object act: TActionList[3] 164 | left = 56 165 | top = 64 166 | object AddAllowed: TAction 167 | Caption = '>' 168 | OnExecute = AddAllowedExecute 169 | OnUpdate = AddAllowedUpdate 170 | end 171 | object RemoveAllowed: TAction 172 | Caption = '<' 173 | OnExecute = RemoveAllowedExecute 174 | OnUpdate = RemoveAllowedUpdate 175 | end 176 | object AddRequired: TAction 177 | Caption = '>' 178 | OnExecute = AddRequiredExecute 179 | OnUpdate = AddRequiredUpdate 180 | end 181 | object RemoveRequired: TAction 182 | Caption = '<' 183 | OnExecute = RemoveRequiredExecute 184 | OnUpdate = RemoveRequiredUpdate 185 | end 186 | end 187 | end 188 | -------------------------------------------------------------------------------- /forms/witchhut_frame.lfm: -------------------------------------------------------------------------------- 1 | inherited WitchHutFrame: TWitchHutFrame 2 | DesignLeft = 495 3 | DesignTop = 185 4 | object edAllowedSkills: TCheckListBox[0] 5 | Left = 8 6 | Height = 208 7 | Top = 24 8 | Width = 304 9 | Anchors = [akTop, akLeft, akRight, akBottom] 10 | Columns = 2 11 | ItemHeight = 0 12 | OnClickCheck = edAllowedSkillsClickCheck 13 | TabOrder = 0 14 | end 15 | object lbAllowedSkills: TLabel[1] 16 | Left = 8 17 | Height = 15 18 | Top = 6 19 | Width = 74 20 | Caption = 'Allowed skills:' 21 | ParentBidiMode = False 22 | ParentColor = False 23 | end 24 | end 25 | -------------------------------------------------------------------------------- /forms/witchhut_frame.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit witchhut_frame; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, CheckLst, 25 | StdCtrls, gui_helpers, base_options_frame, object_options; 26 | 27 | type 28 | 29 | { TWitchHutFrame } 30 | 31 | TWitchHutFrame = class(TBaseOptionsFrame) 32 | edAllowedSkills: TCheckListBox; 33 | lbAllowedSkills: TLabel; 34 | procedure edAllowedSkillsClickCheck(Sender: TObject); 35 | private 36 | FObject: TWitchHutOptions; 37 | public 38 | constructor Create(TheOwner: TComponent); override; 39 | procedure VisitWitchHut(AOptions: TWitchHutOptions); override; 40 | procedure Commit; override; 41 | end; 42 | 43 | implementation 44 | 45 | {$R *.lfm} 46 | 47 | { TWitchHutFrame } 48 | 49 | procedure TWitchHutFrame.Commit; 50 | begin 51 | inherited Commit; 52 | //todo: allow permissive mode 53 | edAllowedSkills.SaveTo(FObject.AllowedSkills, False); 54 | end; 55 | 56 | constructor TWitchHutFrame.Create(TheOwner: TComponent); 57 | begin 58 | inherited Create(TheOwner); 59 | end; 60 | 61 | procedure TWitchHutFrame.edAllowedSkillsClickCheck(Sender: TObject); 62 | var 63 | i, first_checked, last_checked: Integer; 64 | begin 65 | first_checked := -1; 66 | last_checked := -1; 67 | for i := 0 to edAllowedSkills.Count - 1 do 68 | begin 69 | if edAllowedSkills.State[i] = cbChecked then 70 | begin 71 | if first_checked = -1 then 72 | first_checked := i; 73 | last_checked := i; 74 | end; 75 | end; 76 | 77 | //should not hapend but ... 78 | if first_checked = -1 then 79 | begin 80 | edAllowedSkills.State[0] := cbChecked; 81 | first_checked := 0; 82 | last_checked := 0; 83 | end; 84 | 85 | //disallow all uncheked 86 | if first_checked = last_checked then 87 | begin 88 | edAllowedSkills.ItemEnabled[first_checked] := False; 89 | end 90 | else 91 | begin 92 | for i := 0 to edAllowedSkills.Count - 1 do 93 | begin 94 | edAllowedSkills.ItemEnabled[i] := True; 95 | end 96 | end; 97 | end; 98 | 99 | procedure TWitchHutFrame.VisitWitchHut(AOptions: TWitchHutOptions); 100 | begin 101 | inherited VisitWitchHut(AOptions); 102 | FObject := AOptions; 103 | 104 | edAllowedSkills.FillFrom(ListsManager.SkillInfos, AOptions.AllowedSkills); 105 | 106 | edAllowedSkillsClickCheck(nil); 107 | end; 108 | 109 | end. 110 | 111 | -------------------------------------------------------------------------------- /h3_txt.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit h3_txt; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, 25 | vcmi_csvdocument, 26 | filesystem_base,editor_types; 27 | type 28 | 29 | { TTextResource } 30 | 31 | TTextResource = class (TBaseResource, IResource) 32 | public 33 | type 34 | TDelimiter = (Tab,Space); 35 | private 36 | FDelimiter: TDelimiter; 37 | FDoc: TCSVDocument; 38 | FTopRowSkip: Integer; 39 | function GetRowCount: Integer; 40 | function GetValue(Col, Row: Integer): TLocalizedString; 41 | procedure SetDelimiter(AValue: TDelimiter); 42 | public 43 | constructor Create(APath: AnsiString); 44 | destructor Destroy; override; 45 | procedure LoadFromStream(AFileName: AnsiString; AStream: TStream); override; 46 | 47 | property Value[Col,Row: Integer]:TLocalizedString read GetValue; default; 48 | function HasCell(Col,Row: Integer):boolean; 49 | 50 | property RowCount: Integer read GetRowCount; 51 | public 52 | procedure DumpToLog; 53 | 54 | property Delimiter: TDelimiter read FDelimiter write SetDelimiter; 55 | property TopRowSkip: Integer read FTopRowSkip write FTopRowSkip; 56 | end; 57 | 58 | 59 | implementation 60 | 61 | uses LazUTF8, LazLoggerBase; 62 | 63 | 64 | { TTextResource } 65 | 66 | constructor TTextResource.Create(APath: AnsiString); 67 | begin 68 | Inherited Create(TResourceType.Text, APath); 69 | FDoc := TCSVDocument.Create; 70 | 71 | SetDelimiter(TDelimiter.Tab); 72 | 73 | FDoc.EqualColCountPerRow := False; 74 | FDoc.IgnoreOuterWhitespace := False; 75 | FDoc.QuoteOuterWhitespace := False; 76 | FDoc.LineEnding := #13#10; 77 | FDoc.QuoteChar := '"'; 78 | end; 79 | 80 | destructor TTextResource.Destroy; 81 | begin 82 | FDoc.Free; 83 | end; 84 | 85 | function TTextResource.GetRowCount: Integer; 86 | begin 87 | Result := FDoc.RowCount; 88 | end; 89 | 90 | function TTextResource.GetValue(Col, Row: Integer): TLocalizedString; 91 | begin 92 | //TODO: use codepage from vcmi config 93 | row := row + TopRowSkip; 94 | {$IFDEF MSWindows} 95 | Result := WinCPToUTF8(FDoc.Cells[Col,Row]); 96 | {$ELSE} 97 | Result := AnsiToUtf8(FDoc.Cells[Col,Row]);//THIS IS WRONG! 98 | {$ENDIF} 99 | end; 100 | 101 | function TTextResource.HasCell(Col, Row: Integer): boolean; 102 | begin 103 | row := row + TopRowSkip; 104 | Result := FDoc.HasCell(Col,Row); 105 | end; 106 | 107 | procedure TTextResource.DumpToLog; 108 | var 109 | i, j: Integer; 110 | begin 111 | for i := 0 to Pred(FDoc.RowCount) do 112 | begin 113 | for j := 0 to Pred(Fdoc.ColCount[i]) do 114 | begin 115 | DebugLn(['[', j, ',', i,']=',FDoc.Cells[j,i]]); 116 | end; 117 | end; 118 | end; 119 | 120 | procedure TTextResource.LoadFromStream(AFileName: AnsiString; AStream: TStream); 121 | begin 122 | FDoc.LoadFromStream(AStream); 123 | end; 124 | 125 | procedure TTextResource.SetDelimiter(AValue: TDelimiter); 126 | const 127 | DELIMITERS : array[TDelimiter] of TCSVChar = (#9,#$20); 128 | begin 129 | FDelimiter := AValue; 130 | FDoc.Delimiter := DELIMITERS[AValue]; 131 | end; 132 | 133 | 134 | end. 135 | 136 | -------------------------------------------------------------------------------- /locale_manager.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit locale_manager; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, filesystem_base, h3_txt; 25 | 26 | type 27 | 28 | { TLocaleManager } 29 | 30 | TLocaleManager = class(TFSConsumer) 31 | private 32 | FGeneralTexts: TTextResource; 33 | FLossTexts: TTextResource; 34 | FVictoryTexts: TTextResource; 35 | public 36 | constructor Create(AOwner: TComponent); override; 37 | destructor Destroy; override; 38 | 39 | procedure LoadTexts; 40 | 41 | property GeneralTexts: TTextResource read FGeneralTexts; 42 | property VictoryTexts: TTextResource read FVictoryTexts; 43 | property LossTexts: TTextResource read FLossTexts; 44 | end; 45 | 46 | implementation 47 | 48 | const 49 | GENERAL_TEXTS_PATH = 'DATA/GENRLTXT'; 50 | VICTORY_PATH = 'DATA/VCDESC'; 51 | LOSS_PATH = 'DATA/LCDESC'; 52 | 53 | { TLocaleManager } 54 | 55 | constructor TLocaleManager.Create(AOwner: TComponent); 56 | begin 57 | inherited Create(AOwner); 58 | FGeneralTexts := TTextResource.Create(GENERAL_TEXTS_PATH); 59 | FGeneralTexts.TopRowSkip := 1; 60 | FVictoryTexts := TTextResource.Create(VICTORY_PATH); 61 | FLossTexts := TTextResource.Create(LOSS_PATH); 62 | end; 63 | 64 | destructor TLocaleManager.Destroy; 65 | begin 66 | FLossTexts.Free; 67 | FVictoryTexts.Free; 68 | FGeneralTexts.Free; 69 | inherited Destroy; 70 | end; 71 | 72 | procedure TLocaleManager.LoadTexts; 73 | begin 74 | FGeneralTexts.Load(ResourceLoader); 75 | FVictoryTexts.Load(ResourceLoader); 76 | FLossTexts.Load(ResourceLoader); 77 | end; 78 | 79 | end. 80 | 81 | -------------------------------------------------------------------------------- /lod.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit lod; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | SysUtils, Classes, fgl, filesystem_base, zlib_stream, LazUTF8Classes; 25 | 26 | //Format Specifications 27 | // 28 | //char {4} - Header ("LOD\0") 29 | //byte {4} - "file use flag", i.e. used as 'base' or 'extension' resource file. 200 if base resource file, 500 if extension, little endian values. 30 | //uint32 {4} - Number Of Files 31 | //byte {80} - Unknown 32 | // 33 | //// for each file 34 | // 35 | // char {16} - Filename (null) 36 | // uint32 {4} - File Offset 37 | // uint32 {4} - Uncompressed file size 38 | // uint32 {4} - File type(?) 39 | // uint32 {4} - File Length 40 | // 41 | // 42 | //byte {X} - File Data 43 | // 44 | 45 | type 46 | 47 | TLod = class; 48 | 49 | TLodItem = packed record 50 | Filename: array [0..16 - 1] of AnsiChar; 51 | FileOffset: Int32; 52 | UncompressedFileSize: Int32; 53 | FileType: Int32; 54 | FileLength: Int32; 55 | end; 56 | 57 | //todo: add match filter flag to not to store filtered items 58 | TOnItemFound = procedure (Alod: TLod; constref AItem: TLodItem) of object; 59 | 60 | { TLod } 61 | 62 | TLod = class 63 | private 64 | FFileStream: TFileStreamUTF8; 65 | //FBuffer: TZBuffer; 66 | public 67 | constructor Create(AFullPath: string); 68 | destructor Destroy; override; 69 | 70 | procedure Scan(ACallback: TOnItemFound); 71 | 72 | procedure LoadResource(AResource: IResource; constref AItem:TLodItem); 73 | end; 74 | 75 | TLodList = specialize TFPGObjectList; 76 | 77 | implementation 78 | 79 | uses 80 | editor_utils; 81 | 82 | const 83 | LOD_MAGIC: packed array[1..4] of char = ('L','O','D',#0); 84 | LOD_HEADER_SIZE = 4+4+4+80; 85 | 86 | var 87 | GlobalZBuffer: TZBuffer; 88 | GlobalMemBuffer: TMemoryStream; 89 | 90 | { TLod } 91 | 92 | constructor TLod.Create(AFullPath: string); 93 | begin 94 | FFileStream := TFileStreamUTF8.Create(AFullPath, fmOpenRead+fmShareDenyWrite); 95 | //FBuffer := TZBuffer.Create; 96 | end; 97 | 98 | destructor TLod.Destroy; 99 | begin 100 | //FBuffer.Free; 101 | FFileStream.Free; 102 | inherited Destroy; 103 | end; 104 | 105 | procedure TLod.LoadResource(AResource: IResource; constref AItem: TLodItem); 106 | var 107 | zstm: TZlibInputStream; 108 | fname: AnsiString; 109 | begin 110 | //todo: multithreaded LOD decompression 111 | 112 | fname:=AItem.Filename; 113 | 114 | GlobalMemBuffer.SetSize(AItem.UncompressedFileSize); 115 | zstm := nil; 116 | 117 | try 118 | FFileStream.Seek(AItem.FileOffset,soBeginning); 119 | if AItem.FileLength <> 0 then 120 | begin 121 | zstm := TZlibInputStream.Create(GlobalZBuffer, FFileStream, AItem.UncompressedFileSize); 122 | zstm.Read(GlobalMemBuffer.Memory^, AItem.UncompressedFileSize); 123 | end 124 | else begin 125 | FFileStream.Read(GlobalMemBuffer.Memory^, AItem.UncompressedFileSize); 126 | end; 127 | 128 | GlobalMemBuffer.Seek(0, soBeginning); 129 | AResource.LoadFromStream(fname, GlobalMemBuffer); 130 | finally 131 | 132 | if Assigned(zstm) then 133 | begin 134 | zstm.Free; 135 | end; 136 | end; 137 | 138 | end; 139 | 140 | 141 | procedure TLod.Scan(ACallback: TOnItemFound); 142 | var 143 | nomber_of_files: UInt32; 144 | 145 | item: TLodItem; 146 | i: Integer; 147 | 148 | magic: packed array[1..4] of char; 149 | begin 150 | if FFileStream.Size < LOD_HEADER_SIZE then 151 | begin 152 | Exit; //too small, may be empty, ignore silently 153 | end; 154 | FFileStream.Seek(0,soBeginning); 155 | 156 | FFileStream.Read(magic{%H-},SizeOf(magic)); 157 | 158 | if magic <> LOD_MAGIC then 159 | raise Exception.Create('Wrong LOD archive'); 160 | 161 | FFileStream.Seek(8,soBeginning); 162 | 163 | nomber_of_files := FFileStream.ReadDWord; 164 | 165 | FFileStream.Seek(LOD_HEADER_SIZE,soBeginning); 166 | 167 | for i := 0 to nomber_of_files - 1 do 168 | begin 169 | FFileStream.Read(item{%H-},SizeOf(item)); 170 | 171 | LeToNInPlase(item.FileLength); 172 | LeToNInPlase(item.FileOffset); 173 | LeToNInPlase(item.FileType); 174 | LeToNInPlase(item.UncompressedFileSize); 175 | 176 | ACallback(self,item); 177 | end; 178 | end; 179 | 180 | initialization 181 | 182 | GlobalZBuffer := TZBuffer.Create; 183 | GlobalMemBuffer := TMemoryStream.Create; 184 | 185 | finalization 186 | FreeAndNil(GlobalZBuffer); 187 | FreeAndNil(GlobalMemBuffer); 188 | end. 189 | -------------------------------------------------------------------------------- /logical_building_condition.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit logical_building_condition; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, fpjson, logical_expression, vcmi_json; 25 | 26 | type 27 | { TBuildingConditionItem } 28 | 29 | TBuildingConditionItem = class(TLogicalExpressionItem, ISerializeSpecial) 30 | private 31 | FBuilding: AnsiString; 32 | public 33 | constructor Create(ACollection: TCollection); override; 34 | destructor Destroy; override; 35 | public 36 | //ISerializeSpecial 37 | function Serialize(AHandler: TVCMIJSONStreamer): TJSONData; 38 | procedure Deserialize(AHandler: TVCMIJSONDestreamer; ASrc: TJSONData); 39 | public 40 | property Building: AnsiString read FBuilding write FBuilding; 41 | end; 42 | 43 | TBuildingCondition = class(TLogicalExpression) 44 | 45 | end; 46 | 47 | implementation 48 | 49 | uses 50 | typinfo; 51 | 52 | { TBuildingConditionItem } 53 | 54 | constructor TBuildingConditionItem.Create(ACollection: TCollection); 55 | begin 56 | inherited Create(ACollection); 57 | end; 58 | 59 | destructor TBuildingConditionItem.Destroy; 60 | begin 61 | inherited Destroy; 62 | end; 63 | 64 | function TBuildingConditionItem.Serialize(AHandler: TVCMIJSONStreamer): TJSONData; 65 | var 66 | item: TCollectionItem; 67 | begin 68 | Result := CreateJSONArray([]); 69 | 70 | if SubExpressions.Count > 0 then 71 | begin 72 | TJSONArray(Result).Add(GetEnumName( TypeInfo(TLogicalOperator), Integer(LogicalOperator))); 73 | 74 | for item in SubExpressions do 75 | begin 76 | TJSONArray(Result).Add((item as TBuildingConditionItem).Serialize(AHandler)); 77 | end; 78 | end 79 | else 80 | begin 81 | TJSONArray(Result).Add(Building); 82 | end; 83 | end; 84 | 85 | procedure TBuildingConditionItem.Deserialize(AHandler: TVCMIJSONDestreamer; ASrc: TJSONData); 86 | var 87 | ASrcArray: TJSONArray; 88 | instruction_name: TJSONStringType; 89 | raw_instruction: Integer; 90 | i: Integer; 91 | SubExpression: TBuildingConditionItem; 92 | begin 93 | if ASrc.JSONType <> jtArray then 94 | begin 95 | raise Exception.Create('invalid format for building condition, array required'); 96 | end; 97 | 98 | ASrcArray := TJSONArray(ASrc); 99 | 100 | instruction_name := ASrcArray.Strings[0]; 101 | 102 | raw_instruction := GetEnumValue(TypeInfo(TLogicalOperator), instruction_name); 103 | 104 | if raw_instruction >=0 then 105 | begin 106 | LogicalOperator:=TLogicalOperator(raw_instruction); 107 | 108 | for i := 1 to ASrcArray.Count - 1 do 109 | begin 110 | SubExpression := TBuildingConditionItem(SubExpressions.Add); 111 | 112 | SubExpression.Deserialize(AHandler, ASrcArray.Items[i]); 113 | end; 114 | end 115 | else 116 | begin 117 | Building:=instruction_name; 118 | end; 119 | end; 120 | 121 | end. 122 | 123 | -------------------------------------------------------------------------------- /map_format.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit map_format; 18 | 19 | {$I compilersetup.inc} 20 | {$INTERFACES COM} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, Map; 26 | 27 | type 28 | //make it managed object 29 | IMapReader = interface 30 | function Read(AStream: TStream):TVCMIMap; 31 | end; 32 | 33 | 34 | 35 | { TBaseMapFormatHandler } 36 | 37 | TBaseMapFormatHandler = class abstract (TInterfacedObject) 38 | protected 39 | FMapEnv: TMapEnvironment; 40 | public 41 | constructor Create(AMapEnv: TMapEnvironment); virtual; 42 | end; 43 | 44 | TBaseMapFormatHandlerClass = class of TBaseMapFormatHandler; 45 | 46 | implementation 47 | 48 | { TBaseMapFormatHandler } 49 | 50 | constructor TBaseMapFormatHandler.Create(AMapEnv: TMapEnvironment); 51 | begin 52 | FMapEnv := AMapEnv; 53 | 54 | end; 55 | 56 | end. 57 | 58 | -------------------------------------------------------------------------------- /progress_form.lfm: -------------------------------------------------------------------------------- 1 | object ProgressForm: TProgressForm 2 | Left = 332 3 | Height = 320 4 | Top = 232 5 | Width = 514 6 | BorderStyle = bsNone 7 | Caption = 'ProgressForm' 8 | ClientHeight = 320 9 | ClientWidth = 514 10 | FormStyle = fsSplash 11 | OnClose = FormClose 12 | OnCreate = FormCreate 13 | Position = poScreenCenter 14 | ShowInTaskBar = stNever 15 | object pbDetail: TProgressBar 16 | Left = 16 17 | Height = 20 18 | Top = 40 19 | Width = 484 20 | Step = 1 21 | TabOrder = 0 22 | end 23 | object lbDetail: TLabel 24 | Left = 16 25 | Height = 15 26 | Top = 16 27 | Width = 484 28 | Alignment = taCenter 29 | AutoSize = False 30 | Caption = 'lbDetail' 31 | ParentColor = False 32 | end 33 | object Errors: TMemo 34 | Left = 16 35 | Height = 192 36 | Top = 88 37 | Width = 482 38 | ReadOnly = True 39 | ScrollBars = ssAutoVertical 40 | TabOrder = 1 41 | end 42 | object CloseButton: TButton 43 | Left = 216 44 | Height = 25 45 | Top = 288 46 | Width = 75 47 | Action = actClose 48 | TabOrder = 2 49 | end 50 | object act: TActionList 51 | left = 336 52 | top = 280 53 | object actClose: TAction 54 | Caption = 'Close' 55 | OnExecute = actCloseExecute 56 | ShortCut = 27 57 | end 58 | end 59 | end 60 | -------------------------------------------------------------------------------- /progress_form.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit progress_form; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, LazLoggerBase, Forms, Controls, Graphics, Dialogs, ComCtrls, 25 | StdCtrls, ActnList, editor_classes; 26 | 27 | type 28 | 29 | { TProgressForm } 30 | 31 | TProgressForm = class(TForm,IProgressCallback) 32 | act: TActionList; 33 | actClose: TAction; 34 | CloseButton: TButton; 35 | lbDetail: TLabel; 36 | Errors: TMemo; 37 | pbDetail: TProgressBar; 38 | procedure actCloseExecute(Sender: TObject); 39 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 40 | procedure FormCreate(Sender: TObject); 41 | private 42 | FCompleted: Boolean; 43 | FHasErrors: boolean; 44 | FMax: Integer; 45 | FCurrent: integer; 46 | procedure SetCompleted(AValue: Boolean); 47 | { private declarations } 48 | public 49 | property HasErrors: boolean read FHasErrors; 50 | property Completed: Boolean read FCompleted write SetCompleted; 51 | procedure Reset; 52 | public 53 | //IProgressCallback 54 | 55 | function GetMax: Integer; 56 | procedure SetMax(AValue: Integer); 57 | procedure Advance(ADelta: integer); 58 | procedure NextStage(const AStageLabel:string); 59 | procedure AddError(const ADescription: string); 60 | procedure AddMessage(const ADescription: string); 61 | end; 62 | 63 | implementation 64 | 65 | {$R *.lfm} 66 | 67 | { TProgressForm } 68 | 69 | procedure TProgressForm.Advance(ADelta: integer); 70 | var 71 | FOld, FOldNormalized, FCurrentNormalized: Integer; 72 | begin 73 | FOld := FCurrent; 74 | inc(FCurrent, ADelta); 75 | 76 | FOldNormalized := FOld * pbDetail.Max div FMax; 77 | FCurrentNormalized := FCurrent * pbDetail.Max div FMax; 78 | 79 | if FOldNormalized < FCurrentNormalized then 80 | begin 81 | pbDetail.StepBy(FCurrentNormalized - FOldNormalized); 82 | Application.ProcessMessages; 83 | end; 84 | end; 85 | 86 | procedure TProgressForm.FormCreate(Sender: TObject); 87 | begin 88 | Reset; 89 | Height:=75; 90 | Errors.Visible:=false; 91 | end; 92 | 93 | procedure TProgressForm.SetCompleted(AValue: Boolean); 94 | begin 95 | FCompleted:=AValue; 96 | 97 | CloseButton.Enabled := FCompleted; 98 | end; 99 | 100 | procedure TProgressForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); 101 | begin 102 | CloseAction := caHide; //may be reused, owned by root_manager 103 | end; 104 | 105 | procedure TProgressForm.actCloseExecute(Sender: TObject); 106 | begin 107 | Close; 108 | end; 109 | 110 | function TProgressForm.GetMax: Integer; 111 | begin 112 | Result := FMax; 113 | end; 114 | 115 | procedure TProgressForm.NextStage(const AStageLabel: string); 116 | begin 117 | pbDetail.Position := pbDetail.Min; 118 | lbDetail.Caption := AStageLabel; 119 | 120 | Application.ProcessMessages; 121 | end; 122 | 123 | procedure TProgressForm.AddError(const ADescription: string); 124 | begin 125 | Height:=320; 126 | Errors.Visible := true; 127 | 128 | Errors.Append(ADescription); 129 | 130 | DebugLn(ADescription); 131 | 132 | FHasErrors:=True; 133 | end; 134 | 135 | procedure TProgressForm.AddMessage(const ADescription: string); 136 | begin 137 | //todo: use different format 138 | AddError(ADescription); 139 | end; 140 | 141 | procedure TProgressForm.Reset; 142 | begin 143 | pbDetail.Position := pbDetail.Min; 144 | FCurrent:=0; 145 | lbDetail.Caption := ''; 146 | FCompleted:=false; 147 | end; 148 | 149 | procedure TProgressForm.SetMax(AValue: Integer); 150 | begin 151 | FMax := AValue; 152 | FCurrent:=0; 153 | pbDetail.Position := pbDetail.Min; 154 | Application.ProcessMessages; 155 | end; 156 | 157 | end. 158 | 159 | -------------------------------------------------------------------------------- /root_manager.lfm: -------------------------------------------------------------------------------- 1 | object RootManager: TRootManager 2 | OnCreate = DataModuleCreate 3 | OnDestroy = DataModuleDestroy 4 | OldCreateOrder = False 5 | Height = 173 6 | HorizontalOffset = 450 7 | VerticalOffset = 213 8 | Width = 302 9 | PPI = 96 10 | object HeroIcons: TImageList 11 | AllocBy = 16 12 | Height = 64 13 | Width = 58 14 | left = 24 15 | top = 16 16 | end 17 | object VictoryIcons: TImageList 18 | Height = 24 19 | Width = 32 20 | left = 96 21 | top = 16 22 | end 23 | object DefeatIcons: TImageList 24 | Height = 24 25 | Width = 32 26 | left = 168 27 | top = 16 28 | end 29 | end 30 | -------------------------------------------------------------------------------- /shaders/default_f.glsl: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | 3 | const int playerColorIndex = 5; 4 | uniform usampler2D bitmap; 5 | uniform sampler1D palette; 6 | uniform sampler2D bitmapRGB; 7 | 8 | uniform int useTexture = 0; 9 | 10 | uniform int useFlag = 0; 11 | uniform vec4 flagColor; 12 | uniform vec4 fragmentColor; 13 | in vec2 UV; 14 | out vec4 outColor; 15 | 16 | vec4 applyFlag(int inColor) 17 | { 18 | if(useFlag == 1) 19 | { 20 | if(inColor == playerColorIndex) 21 | return flagColor; 22 | } 23 | return texelFetch(palette, inColor, 0); 24 | } 25 | 26 | vec4 applyTextureWithPalette() 27 | { 28 | return applyFlag(int(texture(bitmap,UV).r)); 29 | } 30 | 31 | vec4 applyTexture() 32 | { 33 | return texture(bitmapRGB,UV); 34 | } 35 | 36 | void main() 37 | { 38 | if(useTexture == 2) 39 | { 40 | outColor = applyTexture(); 41 | } 42 | else if(useTexture == 1) 43 | { 44 | outColor = applyTextureWithPalette(); 45 | } 46 | else 47 | { 48 | outColor = fragmentColor; 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /shaders/default_v.glsl: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | 3 | uniform mat4 projMatrix; 4 | uniform mat4 translateMatrix; 5 | 6 | in vec2 coords; 7 | in vec2 uv; 8 | out vec2 UV; 9 | 10 | void main() 11 | { 12 | UV = uv; 13 | gl_Position = projMatrix * translateMatrix * vec4(coords,0.0,1.0); 14 | } 15 | -------------------------------------------------------------------------------- /stream_adapter.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | . You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit stream_adapter; 18 | 19 | {$I compilersetup.inc} 20 | 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FileUtil, LazUTF8, editor_types; 26 | 27 | type 28 | 29 | { TStreamAdapter } 30 | 31 | TStreamAdapter = object 32 | strict protected 33 | FStm: TStream; 34 | public 35 | constructor Create(dest: TStream); 36 | end; 37 | 38 | { TStreamReadAdapter } 39 | 40 | TStreamReadAdapter = object (TStreamAdapter) 41 | public 42 | constructor Create(dest: TStream); 43 | 44 | procedure ReadBuffer(var Buffer; Count: Longint); 45 | 46 | function ReadLocalizedString: TLocalizedString; 47 | function ReadString: AnsiString; 48 | 49 | function ReadDWord: DWord;inline; 50 | function ReadInt32: int32;inline; 51 | function ReadWord: Word;inline; 52 | 53 | function ReadByte: Byte; inline; 54 | function ReadBoolean: Boolean; inline; 55 | 56 | procedure Skip(Count: Integer); 57 | procedure SkipString; 58 | 59 | function ReadIDByte:TCustomID; 60 | 61 | function GetPos: Int64; 62 | end; 63 | 64 | { TStreamWriteAdapter } 65 | 66 | TStreamWriteAdapter = object (TStreamAdapter) 67 | public 68 | constructor Create(dest: TStream); 69 | 70 | procedure WriteString(str: ansistring); inline; 71 | procedure WriteZero(size: integer);inline; 72 | procedure WriteByte(V: uint8; rep:integer = 1); inline; 73 | procedure WriteWord(V: Word);inline; 74 | procedure WriteDword(V: DWord);inline; 75 | procedure WriteBuffer(const Buffer; Count: Longint); 76 | end; 77 | 78 | 79 | 80 | implementation 81 | 82 | { TStreamReadAdapter } 83 | 84 | constructor TStreamReadAdapter.Create(dest: TStream); 85 | begin 86 | inherited Create(dest); 87 | end; 88 | 89 | function TStreamReadAdapter.ReadBoolean: Boolean; 90 | begin 91 | Result := ReadByte <> 0; 92 | end; 93 | 94 | procedure TStreamReadAdapter.ReadBuffer(var Buffer; Count: Longint); 95 | begin 96 | FStm.Read(Buffer,Count); 97 | end; 98 | 99 | function TStreamReadAdapter.ReadByte: Byte; 100 | begin 101 | Result := FStm.ReadByte; 102 | end; 103 | 104 | function TStreamReadAdapter.ReadDWord: DWord; 105 | begin 106 | Result := LEtoN(FStm.ReadDWord); 107 | end; 108 | 109 | function TStreamReadAdapter.ReadInt32: int32; 110 | begin 111 | Result := Int32(ReadDWord); 112 | end; 113 | 114 | function TStreamReadAdapter.ReadIDByte: TCustomID; 115 | var 116 | b: Byte; 117 | begin 118 | b := ReadByte; 119 | if b = 255 then 120 | Result := ID_RANDOM 121 | else 122 | Result := b; 123 | end; 124 | 125 | function TStreamReadAdapter.GetPos: Int64; 126 | begin 127 | Result := FStm.Position; 128 | end; 129 | 130 | function TStreamReadAdapter.ReadLocalizedString: TLocalizedString; 131 | begin 132 | //TODO: use codepage from vcmi config 133 | {$IFDEF MSWindows} 134 | Result := WinCPToUTF8(ReadString); 135 | {$ELSE} 136 | Result := AnsiToUtf8(ReadString);//THIS IS WRONG! 137 | {$ENDIF} 138 | end; 139 | 140 | function TStreamReadAdapter.ReadString: AnsiString; 141 | var 142 | L: int32; 143 | begin 144 | L := ReadDWord; 145 | SetLength(Result,L); 146 | if L > 0 then ReadBuffer(Result[1],L); 147 | end; 148 | 149 | function TStreamReadAdapter.ReadWord: Word; 150 | begin 151 | Result := LEtoN(FStm.ReadWord); 152 | end; 153 | 154 | procedure TStreamReadAdapter.Skip(Count: Integer); 155 | begin 156 | FStm.Seek(Count,soCurrent); 157 | end; 158 | 159 | procedure TStreamReadAdapter.SkipString; 160 | var 161 | L: int32; 162 | begin 163 | L := ReadDWord; 164 | Skip(L); 165 | end; 166 | 167 | { TStreamAdapter } 168 | 169 | constructor TStreamAdapter.Create(dest: TStream); 170 | begin 171 | FStm := dest; 172 | end; 173 | 174 | { TStreamWriteAdapter } 175 | 176 | constructor TStreamWriteAdapter.Create(dest: TStream); 177 | begin 178 | inherited Create(dest); 179 | end; 180 | 181 | procedure TStreamWriteAdapter.WriteBuffer(const Buffer; Count: Longint); 182 | begin 183 | FStm.WriteBuffer(Buffer,Count); 184 | end; 185 | 186 | procedure TStreamWriteAdapter.WriteByte(V: uint8; rep: integer); 187 | var 188 | i: Integer; 189 | begin 190 | for i:=1 to rep do 191 | begin 192 | FStm.WriteByte(V); 193 | end; 194 | end; 195 | 196 | procedure TStreamWriteAdapter.WriteDword(V: DWord); 197 | begin 198 | FStm.WriteDWord(NtoLE(V)); 199 | end; 200 | 201 | procedure TStreamWriteAdapter.WriteString(str: ansistring); 202 | var 203 | L: int32; 204 | begin 205 | L:=Length(str); //assume string cant be too large 206 | WriteDWord(L); 207 | FStm.WriteBuffer(Pointer(str)^,L); 208 | end; 209 | 210 | procedure TStreamWriteAdapter.WriteWord(V: Word); 211 | begin 212 | FStm.WriteWord(NtoLE(V)); 213 | end; 214 | 215 | procedure TStreamWriteAdapter.WriteZero(size: integer); 216 | begin 217 | WriteByte(0, size); 218 | end; 219 | 220 | end. 221 | 222 | -------------------------------------------------------------------------------- /tests/test_csvdocunent.pas: -------------------------------------------------------------------------------- 1 | unit test_CSVDocunent; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, fpcunit, testregistry, vcmi_csvdocument, vcmi_csvreadwrite; 9 | 10 | type 11 | 12 | { TTestCSVParser } 13 | 14 | TTestCSVParser = class(TTestCase) 15 | private 16 | FParser: TCSVParser; 17 | protected 18 | procedure SetUp; override; 19 | procedure TearDown; override; 20 | 21 | procedure AssertNextCell(ret: Boolean; col, row: Integer; value: String); 22 | published 23 | procedure TestLineBreak; 24 | procedure TestLineBreakEmptyCells; 25 | procedure TestEmptyCells; 26 | end; 27 | 28 | { TTestCSVDocunent } 29 | 30 | TTestCSVDocunent = class(TTestCase) 31 | private 32 | FDoc: TCSVDocument; 33 | protected 34 | procedure SetUp; override; 35 | procedure TearDown; override; 36 | published 37 | procedure TestLineBreak; 38 | procedure TestLineBreak2; 39 | procedure TestLineBreak3; 40 | procedure TestLineBreak4; 41 | end; 42 | 43 | implementation 44 | 45 | { TTestCSVParser } 46 | 47 | procedure TTestCSVParser.SetUp; 48 | begin 49 | FParser := TCSVParser.Create; 50 | FParser.EqualColCountPerRow := False; 51 | FParser.IgnoreOuterWhitespace := False; 52 | FParser.QuoteOuterWhitespace := False; 53 | FParser.LineEnding := #13#10; 54 | FParser.QuoteChar := '"'; 55 | FParser.Delimiter:=#9; 56 | end; 57 | 58 | procedure TTestCSVParser.TearDown; 59 | begin 60 | FParser.Free; 61 | end; 62 | 63 | procedure TTestCSVParser.AssertNextCell(ret: Boolean; col, row: Integer; value: String); 64 | begin 65 | AssertEquals('ParseNextCell', ret, FParser.ParseNextCell); 66 | AssertEquals('col', col, FParser.CurrentCol); 67 | AssertEquals('row', row, FParser.CurrentRow); 68 | AssertEquals('cell value', value, FParser.CurrentCellText); 69 | end; 70 | 71 | procedure TTestCSVParser.TestLineBreak; 72 | const 73 | data = '1'#9'100'#13#10'2'#9'101'#13#10; 74 | begin 75 | FParser.SetSource(data); 76 | AssertNextCell(true, 0,0,'1'); 77 | AssertNextCell(true, 1,0,'100'); 78 | AssertNextCell(true, 0,1,'2'); 79 | AssertNextCell(true, 1,1,'101'); 80 | AssertEquals('eof', false, FParser.ParseNextCell); 81 | end; 82 | 83 | procedure TTestCSVParser.TestLineBreakEmptyCells; 84 | const 85 | data = #9#13#10#9; 86 | begin 87 | FParser.SetSource(data); 88 | AssertNextCell(true, 0,0,''); 89 | AssertNextCell(true, 1,0,''); 90 | 91 | AssertNextCell(true, 0,1,''); 92 | AssertNextCell(true, 1,1,''); 93 | end; 94 | 95 | procedure TTestCSVParser.TestEmptyCells; 96 | const 97 | data = #9#9#9; 98 | begin 99 | FParser.SetSource(data); 100 | AssertNextCell(true, 0,0,''); 101 | AssertNextCell(true, 1,0,''); 102 | AssertNextCell(true, 2,0,''); 103 | AssertNextCell(true, 3,0,''); 104 | AssertEquals('eof', false, FParser.ParseNextCell); 105 | end; 106 | 107 | { TTestCSVDocunent } 108 | 109 | procedure TTestCSVDocunent.TestLineBreak; 110 | const 111 | data = '1'#9'100'#13#10'2'#9'101'#13#10; 112 | begin 113 | FDoc.CSVText:=data; 114 | 115 | AssertEquals('Row count', 2, FDoc.RowCount); 116 | AssertEquals('Col count 0', 2, FDoc.ColCount[0]); 117 | AssertEquals('Col count 1', 2, FDoc.ColCount[1]); 118 | AssertEquals('[0,0]', '1', FDoc.Cells[0,0]); 119 | AssertEquals('[0,1]', '100', FDoc.Cells[1,0]); 120 | AssertEquals('[1,0]', '2', FDoc.Cells[0,1]); 121 | AssertEquals('[1,1]', '101', FDoc.Cells[1,1]); 122 | end; 123 | 124 | procedure TTestCSVDocunent.TestLineBreak2; 125 | const 126 | data = '1'#9'"10'#13#10'0"'#9#9#9#13#10'2'#9'101'#9; 127 | begin 128 | FDoc.CSVText:=data; 129 | 130 | AssertEquals('Row count', 2, FDoc.RowCount); 131 | AssertEquals('Col count 0', 5, FDoc.ColCount[0]); 132 | AssertEquals('Col count 1', 3, FDoc.ColCount[1]); 133 | AssertEquals('[0,0]', '1', FDoc.Cells[0,0]); 134 | AssertEquals('[0,1]', '10'#13#10'0', FDoc.Cells[1,0]); 135 | AssertEquals('[0,2]', '', FDoc.Cells[2,0]); 136 | AssertEquals('[1,0]', '2', FDoc.Cells[0,1]); 137 | AssertEquals('[1,1]', '101', FDoc.Cells[1,1]); 138 | AssertEquals('[1,2]', '', FDoc.Cells[2,1]); 139 | end; 140 | 141 | procedure TTestCSVDocunent.TestLineBreak3; 142 | const 143 | data = '"123"'#9#9#13#10'"321"'; 144 | begin 145 | FDoc.CSVText:=data; 146 | AssertEquals('Row count', 2, FDoc.RowCount); 147 | AssertEquals('Col count 0', 3, FDoc.ColCount[0]); 148 | AssertEquals('Col count 1', 1, FDoc.ColCount[1]); 149 | AssertEquals('[0,0]', '123', FDoc.Cells[0,0]); 150 | AssertEquals('[1,0]', '321', FDoc.Cells[0,1]); 151 | end; 152 | 153 | procedure TTestCSVDocunent.TestLineBreak4; 154 | const 155 | data = '"123"'#9#9#13#10'321'; 156 | begin 157 | FDoc.CSVText:=data; 158 | AssertEquals('Row count', 2, FDoc.RowCount); 159 | AssertEquals('Col count 0', 3, FDoc.ColCount[0]); 160 | AssertEquals('Col count 1', 1, FDoc.ColCount[1]); 161 | AssertEquals('[0,0]', '123', FDoc.Cells[0,0]); 162 | AssertEquals('[1,0]', '321', FDoc.Cells[0,1]); 163 | end; 164 | 165 | procedure TTestCSVDocunent.SetUp; 166 | begin 167 | FDoc := TCSVDocument.Create; 168 | FDoc.EqualColCountPerRow := False; 169 | FDoc.IgnoreOuterWhitespace := False; 170 | FDoc.QuoteOuterWhitespace := False; 171 | FDoc.LineEnding := #13#10; 172 | FDoc.QuoteChar := '"'; 173 | FDoc.Delimiter:=#9; 174 | end; 175 | 176 | procedure TTestCSVDocunent.TearDown; 177 | begin 178 | FDoc.Free; 179 | end; 180 | 181 | initialization 182 | 183 | RegisterTest(TTestCSVParser); 184 | RegisterTest(TTestCSVDocunent); 185 | end. 186 | 187 | -------------------------------------------------------------------------------- /tests/unit_tests.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | <UseAppBundle Value="False"/> 10 | <ResourceType Value="res"/> 11 | </General> 12 | <i18n> 13 | <EnableI18N LFM="False"/> 14 | </i18n> 15 | <BuildModes Count="1"> 16 | <Item1 Name="Default" Default="True"/> 17 | </BuildModes> 18 | <PublishOptions> 19 | <Version Value="2"/> 20 | </PublishOptions> 21 | <RunParams> 22 | <local> 23 | <CommandLineParams Value="-a --format=plain"/> 24 | </local> 25 | <FormatVersion Value="2"/> 26 | <Modes Count="1"> 27 | <Mode0 Name="default"> 28 | <local> 29 | <CommandLineParams Value="-a --format=plain"/> 30 | </local> 31 | </Mode0> 32 | </Modes> 33 | </RunParams> 34 | <RequiredPackages Count="2"> 35 | <Item1> 36 | <PackageName Value="FPCUnitConsoleRunner"/> 37 | </Item1> 38 | <Item2> 39 | <PackageName Value="FCL"/> 40 | </Item2> 41 | </RequiredPackages> 42 | <Units Count="4"> 43 | <Unit0> 44 | <Filename Value="unit_tests.lpr"/> 45 | <IsPartOfProject Value="True"/> 46 | </Unit0> 47 | <Unit1> 48 | <Filename Value="test_csvdocunent.pas"/> 49 | <IsPartOfProject Value="True"/> 50 | <UnitName Value="test_CSVDocunent"/> 51 | </Unit1> 52 | <Unit2> 53 | <Filename Value="../3rd_party/vcmi_csvdocument.pp"/> 54 | <IsPartOfProject Value="True"/> 55 | </Unit2> 56 | <Unit3> 57 | <Filename Value="../3rd_party/vcmi_csvreadwrite.pp"/> 58 | <IsPartOfProject Value="True"/> 59 | </Unit3> 60 | </Units> 61 | </ProjectOptions> 62 | <CompilerOptions> 63 | <Version Value="11"/> 64 | <Target> 65 | <Filename Value="./unit_tests"/> 66 | </Target> 67 | <SearchPaths> 68 | <IncludeFiles Value="$(ProjOutDir)"/> 69 | <OtherUnitFiles Value="..;../3rd_party"/> 70 | <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)-$(BuildMode)"/> 71 | </SearchPaths> 72 | <Parsing> 73 | <SyntaxOptions> 74 | <IncludeAssertionCode Value="True"/> 75 | </SyntaxOptions> 76 | </Parsing> 77 | <CodeGeneration> 78 | <Checks> 79 | <IOChecks Value="True"/> 80 | </Checks> 81 | </CodeGeneration> 82 | <Linking> 83 | <Debugging> 84 | <DebugInfoType Value="dsDwarf2"/> 85 | </Debugging> 86 | </Linking> 87 | </CompilerOptions> 88 | <Debugging> 89 | <Exceptions Count="3"> 90 | <Item1> 91 | <Name Value="EAbort"/> 92 | </Item1> 93 | <Item2> 94 | <Name Value="ECodetoolError"/> 95 | </Item2> 96 | <Item3> 97 | <Name Value="EFOpenError"/> 98 | </Item3> 99 | </Exceptions> 100 | </Debugging> 101 | </CONFIG> 102 | -------------------------------------------------------------------------------- /tests/unit_tests.lpr: -------------------------------------------------------------------------------- 1 | program unit_tests; 2 | 3 | {$mode objfpc}{$H+} 4 | {$WARN 5024 off : Parameter "$1" not used} 5 | uses 6 | Classes, 7 | fpcunit, testregistry, testutils, fpcunitreport, 8 | consoletestrunner, test_CSVDocunent; 9 | 10 | type 11 | 12 | { TErrorCounter } 13 | 14 | TErrorCounter = class(TNoRefCountObject, ITestListener) 15 | private 16 | FTotalErrors: Integer; 17 | public 18 | procedure AddFailure(ATest: TTest; AFailure: TTestFailure); 19 | procedure AddError(ATest: TTest; AError: TTestFailure); 20 | procedure StartTest(ATest: TTest); 21 | procedure EndTest(ATest: TTest); 22 | procedure StartTestSuite(ATestSuite: TTestSuite); 23 | procedure EndTestSuite(ATestSuite: TTestSuite); 24 | 25 | property TotalErrors: Integer read FTotalErrors; 26 | end; 27 | 28 | { TMyProgressWriter } 29 | 30 | TMyProgressWriter = class(TNoRefCountObject, ITestListener) 31 | private 32 | FSuccess: boolean; 33 | procedure WriteChar(c: char); 34 | public 35 | destructor Destroy; override; 36 | 37 | procedure AddFailure(ATest: TTest; AFailure: TTestFailure); 38 | procedure AddError(ATest: TTest; AError: TTestFailure); 39 | procedure StartTest(ATest: TTest); 40 | procedure EndTest(ATest: TTest); 41 | procedure StartTestSuite(ATestSuite: TTestSuite); 42 | procedure EndTestSuite(ATestSuite: TTestSuite); 43 | end; 44 | 45 | { TMyTestRunner } 46 | 47 | TMyTestRunner = class(TTestRunner) 48 | strict private 49 | FErrorCounter: TErrorCounter; 50 | protected 51 | procedure DoRun; override; 52 | procedure DoTestRun(ATest: TTest); override; 53 | public 54 | constructor Create(AOwner: TComponent); override; 55 | destructor Destroy; override; 56 | end; 57 | 58 | var 59 | Application: TMyTestRunner; 60 | 61 | procedure TErrorCounter.AddFailure(ATest: TTest; AFailure: TTestFailure); 62 | begin 63 | Inc(FTotalErrors); 64 | end; 65 | 66 | procedure TErrorCounter.AddError(ATest: TTest; AError: TTestFailure); 67 | begin 68 | Inc(FTotalErrors); 69 | end; 70 | 71 | procedure TErrorCounter.StartTest(ATest: TTest); 72 | begin 73 | // do nothing 74 | end; 75 | 76 | procedure TErrorCounter.EndTest(ATest: TTest); 77 | begin 78 | // do nothing 79 | end; 80 | 81 | procedure TErrorCounter.StartTestSuite(ATestSuite: TTestSuite); 82 | begin 83 | // do nothing 84 | end; 85 | 86 | procedure TErrorCounter.EndTestSuite(ATestSuite: TTestSuite); 87 | begin 88 | // do nothing 89 | end; 90 | 91 | { TMyProgressWriter } 92 | 93 | procedure TMyProgressWriter.WriteChar(c: char); 94 | begin 95 | write(c); 96 | // flush output, so that we see the char immediately, even it is written to file 97 | Flush(output); 98 | end; 99 | 100 | destructor TMyProgressWriter.Destroy; 101 | begin 102 | // on descruction, just write the missing line ending 103 | writeln; 104 | inherited Destroy; 105 | end; 106 | 107 | procedure TMyProgressWriter.AddFailure(ATest: TTest; AFailure: TTestFailure); 108 | begin 109 | FSuccess := false; 110 | writechar('F'); 111 | end; 112 | 113 | procedure TMyProgressWriter.AddError(ATest: TTest; AError: TTestFailure); 114 | begin 115 | FSuccess := false; 116 | writechar('E'); 117 | end; 118 | 119 | procedure TMyProgressWriter.StartTest(ATest: TTest); 120 | begin 121 | FSuccess := true; // assume success, until proven otherwise 122 | end; 123 | 124 | procedure TMyProgressWriter.EndTest(ATest: TTest); 125 | begin 126 | if FSuccess then 127 | writechar('.'); 128 | end; 129 | 130 | procedure TMyProgressWriter.StartTestSuite(ATestSuite: TTestSuite); 131 | begin 132 | // do nothing 133 | end; 134 | 135 | procedure TMyProgressWriter.EndTestSuite(ATestSuite: TTestSuite); 136 | begin 137 | // do nothing 138 | end; 139 | 140 | { TMyTestRunner } 141 | 142 | procedure TMyTestRunner.DoRun; 143 | begin 144 | inherited DoRun; 145 | ExitCode:=FErrorCounter.TotalErrors; 146 | end; 147 | 148 | procedure TMyTestRunner.DoTestRun(ATest: TTest); 149 | var 150 | ResultsWriter: TCustomResultsWriter; 151 | ProgressWriter: TMyProgressWriter; 152 | TestResult: TTestResult; 153 | begin 154 | ResultsWriter := GetResultsWriter; 155 | ResultsWriter.Filename := FileName; 156 | TestResult := TTestResult.Create; 157 | try 158 | if ShowProgress then 159 | begin 160 | ProgressWriter := TMyProgressWriter.Create; 161 | TestResult.AddListener(ProgressWriter); 162 | end 163 | else 164 | ProgressWriter := nil; 165 | TestResult.AddListener(ResultsWriter); 166 | TestResult.AddListener(FErrorCounter); 167 | ATest.Run(TestResult); 168 | ResultsWriter.WriteResult(TestResult); 169 | finally 170 | TestResult.Free; 171 | ResultsWriter.Free; 172 | ProgressWriter.Free; 173 | end; 174 | end; 175 | 176 | constructor TMyTestRunner.Create(AOwner: TComponent); 177 | begin 178 | inherited Create(AOwner); 179 | FErrorCounter := TErrorCounter.Create; 180 | end; 181 | 182 | destructor TMyTestRunner.Destroy; 183 | begin 184 | FErrorCounter.Free; 185 | inherited Destroy; 186 | end; 187 | 188 | begin 189 | Application := TMyTestRunner.Create(nil); 190 | Application.Initialize; 191 | Application.Run; 192 | Application.Free; 193 | end. 194 | -------------------------------------------------------------------------------- /transitions.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit transitions; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, gvector; 26 | const 27 | 28 | 29 | FLIP_PATTERN_HORIZONTAL = 1; 30 | FLIP_PATTERN_VERTICAL = 2; 31 | FLIP_PATTERN_BOTH = 3; 32 | 33 | type 34 | 35 | TMapping = record 36 | Lower, Upper: Integer; 37 | end; 38 | 39 | TMappings = specialize TVector<TMapping>; 40 | 41 | TValidationResult = record 42 | result: Boolean; 43 | transitionReplacement: string; 44 | flip: Integer; 45 | end; 46 | 47 | implementation 48 | 49 | end. 50 | 51 | -------------------------------------------------------------------------------- /undo_base.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit undo_base; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils; 25 | 26 | type 27 | 28 | TUndoItemState = (Idle, UnDone, ReDone); 29 | 30 | { TAbstractUndoItem } 31 | 32 | TAbstractUndoItem = class abstract 33 | private 34 | FState: TUndoItemState; 35 | protected 36 | function GetDescription: string; virtual; abstract; 37 | public 38 | property State:TUndoItemState read FState write FState; 39 | 40 | procedure Undo; virtual; abstract; 41 | procedure Redo; virtual; abstract; 42 | //return true if action was actually executed 43 | function Execute: boolean; virtual; abstract; 44 | property Description: string read GetDescription; 45 | end; 46 | 47 | { TAbstractUndoManager } 48 | 49 | TAbstractUndoManager = class abstract 50 | protected 51 | class procedure SetItemState(AItem: TAbstractUndoItem; AState: TUndoItemState); static; 52 | public 53 | //Last executed item. Will be undone first 54 | function PeekCurrent: TAbstractUndoItem; virtual; abstract; 55 | //Last undone item. Will be redone next if any 56 | function PeekNext: TAbstractUndoItem; virtual; abstract; 57 | 58 | //current present 59 | function CanUndo: boolean; virtual; abstract; 60 | //next present 61 | function CanRedo: boolean; virtual; abstract; 62 | 63 | procedure Undo; virtual; abstract; 64 | procedure Redo; virtual; abstract; 65 | 66 | //redo action (= first execute), push to stack, acquire ownership 67 | function ExecuteItem(AItem: TAbstractUndoItem): boolean; virtual; abstract; 68 | 69 | procedure Clear; virtual; abstract; 70 | end; 71 | 72 | implementation 73 | 74 | { TAbstractUndoManager } 75 | 76 | class procedure TAbstractUndoManager.SetItemState(AItem: TAbstractUndoItem; 77 | AState: TUndoItemState); 78 | begin 79 | AItem.State:=AState; 80 | end; 81 | 82 | 83 | 84 | end. 85 | 86 | -------------------------------------------------------------------------------- /vcmi.dirs.base.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit vcmi.dirs.base; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, LazUTF8, LazFileUtils, LazUTF8Classes; 26 | 27 | type 28 | TDirs = class; 29 | TDirsClass = class of TDirs; 30 | 31 | { TDirs } 32 | 33 | TDirs = class 34 | private 35 | FExecutablePath: AnsiString; 36 | FPathsConfig: TStringListUTF8; 37 | protected 38 | function GetUserProfilePath: AnsiString; virtual; 39 | function GetUserCachePath: AnsiString; virtual; 40 | function GetUserConfigPath: AnsiString; virtual; 41 | public 42 | constructor Create; virtual; 43 | destructor Destroy; override; 44 | 45 | property UserCachePath: AnsiString read GetUserCachePath; 46 | property UserConfigPath: AnsiString read GetUserConfigPath; 47 | 48 | procedure FillDataPaths(AList: TStringListUTF8); virtual; 49 | 50 | procedure CreatePaths; 51 | 52 | class function GetActualClass: TDirsClass; 53 | end; 54 | 55 | implementation 56 | 57 | {$PUSH} 58 | {$WARN SYMBOL_PLATFORM OFF} 59 | {$WARN UNIT_PLATFORM OFF} 60 | 61 | {$IF DEFINED (MSWINDOWS)} 62 | uses vcmi.dirs.windows; 63 | type 64 | TDirsActual = TDirsWindows; 65 | {$ELSEIF DEFINED (LINUX) OR DEFINED(BSD) AND NOT DEFINED(DARWIN)} 66 | uses vcmi.dirs.xdg; 67 | 68 | type 69 | TDirsActual = TDirsXDG; 70 | {$ELSE} 71 | {$WARNING OS target not supported} 72 | type 73 | TDirsActual = TDirs; 74 | {$ENDIF} 75 | {$POP} 76 | 77 | const 78 | GAME_PATH_CONFIG = 'gamepath.txt'; 79 | 80 | 81 | { TDirs } 82 | 83 | function TDirs.GetUserConfigPath: AnsiString; 84 | begin 85 | Result := GetUserProfilePath(); 86 | end; 87 | 88 | function TDirs.GetUserProfilePath: AnsiString; 89 | begin 90 | Result := FExecutablePath; //fallback to executable path 91 | end; 92 | 93 | function TDirs.GetUserCachePath: AnsiString; 94 | begin 95 | Result := GetUserProfilePath(); 96 | end; 97 | 98 | constructor TDirs.Create; 99 | var 100 | s: AnsiString; 101 | begin 102 | FPathsConfig := TStringListUTF8.Create; 103 | FExecutablePath := ExtractFilePath(ParamStrUTF8(0)); 104 | 105 | s := FExecutablePath + GAME_PATH_CONFIG; 106 | 107 | if FileExistsUTF8(s) then 108 | begin 109 | FPathsConfig.LoadFromFile(s); 110 | end; 111 | 112 | FPathsConfig.Insert(0, FExecutablePath); 113 | end; 114 | 115 | destructor TDirs.Destroy; 116 | begin 117 | FPathsConfig.Free; 118 | inherited Destroy; 119 | end; 120 | 121 | procedure TDirs.FillDataPaths(AList: TStringListUTF8); 122 | begin 123 | AList.AddStrings(FPathsConfig); 124 | 125 | AList.Add(GetUserProfilePath()); 126 | end; 127 | 128 | procedure TDirs.CreatePaths; 129 | begin 130 | if not ForceDirectoriesUTF8(UserCachePath) then 131 | begin 132 | raise Exception.CreateFmt('Unable to create path %s',[UserCachePath]); 133 | end; 134 | end; 135 | 136 | class function TDirs.GetActualClass: TDirsClass; 137 | begin 138 | Result := TDirsActual; 139 | end; 140 | 141 | end. 142 | 143 | -------------------------------------------------------------------------------- /vcmi.dirs.windows.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit vcmi.dirs.windows platform; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, LazUTF8, vcmi.dirs.base; 26 | 27 | type 28 | 29 | { TDirsWindows } 30 | 31 | TDirsWindows = class(TDirs) 32 | protected 33 | function GetUserProfilePath: AnsiString; override; 34 | public 35 | constructor Create; override; 36 | end platform; 37 | 38 | 39 | implementation 40 | 41 | uses windirs; 42 | 43 | { TDirsWindows } 44 | 45 | function TDirsWindows.GetUserProfilePath: AnsiString; 46 | begin 47 | result := GetWindowsSpecialDir(CSIDL_PERSONAL); 48 | 49 | if result = '' then 50 | begin 51 | result:= GetEnvironmentVariableUTF8('HOMEDRIVE') + GetEnvironmentVariableUTF8('HOMEPATH'); 52 | 53 | result := IncludeTrailingPathDelimiter(result); 54 | 55 | result := result + 'Documents\My Games\vcmi\'; 56 | end 57 | else 58 | begin 59 | Result := Result+'My Games\vcmi\'; 60 | end; 61 | end; 62 | 63 | constructor TDirsWindows.Create; 64 | begin 65 | inherited Create; 66 | end; 67 | 68 | end. 69 | 70 | -------------------------------------------------------------------------------- /vcmi.dirs.xdg.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit vcmi.dirs.xdg platform; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, vcmi.dirs.base; 26 | 27 | type 28 | 29 | { TDirsXDG } 30 | 31 | TDirsXDG = class(TDirs) 32 | protected 33 | function GetUserProfilePath: AnsiString; override; 34 | public 35 | constructor Create; override; 36 | 37 | end platform; 38 | 39 | implementation 40 | 41 | { TDirsXDG } 42 | 43 | function TDirsXDG.GetUserProfilePath: AnsiString; 44 | begin 45 | Result:='.'; 46 | end; 47 | 48 | constructor TDirsXDG.Create; 49 | begin 50 | inherited Create; 51 | end; 52 | 53 | end. 54 | 55 | -------------------------------------------------------------------------------- /vcmi.image_formats.h3pcx.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project. 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | 18 | unit vcmi.image_formats.h3pcx; 19 | 20 | {$I compilersetup.inc} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, FPImage, Graphics, IntfGraphics, GraphType, stream_adapter, editor_types; 26 | 27 | procedure LoadH3Pcx(ASourceStream: TStream; ADest: TLazIntfImage); 28 | 29 | implementation 30 | 31 | procedure LoadH3Pcx(ASourceStream: TStream; ADest: TLazIntfImage); 32 | var 33 | size, width, height: UInt32; 34 | source: TStreamReadAdapter; 35 | 36 | procedure InitBitmap(); 37 | begin 38 | ADest.SetSize(width, height); 39 | end; 40 | 41 | procedure LoadH3Pcx24; 42 | var 43 | c: TH3DefColor; 44 | i, j: Integer; 45 | begin 46 | 47 | ADest.BeginUpdate(); 48 | try 49 | for i := 0 to height - 1 do 50 | begin 51 | for j := 0 to width - 1 do 52 | begin 53 | ASourceStream.Read(c, 3); 54 | ADest.Colors[j,i] := FPColor(word(c.r) shl 8 + c.r, word(c.g) shl 8 + c.g, word(c.b) shl 8 + c.b); 55 | end; 56 | end; 57 | finally 58 | ADest.EndUpdate() 59 | end; 60 | 61 | end; 62 | 63 | procedure LoadH3Pcx8; 64 | var 65 | initial_pos: Int64; 66 | c: TH3DefColor; 67 | buffer: packed array of byte; 68 | i, j: Integer; 69 | p: PByte; 70 | begin 71 | ADest.BeginUpdate(); 72 | try 73 | ADest.UsePalette:=true; 74 | ADest.Palette.Create(256); 75 | initial_pos := ASourceStream.Position; 76 | 77 | //load palette from end of file 78 | ASourceStream.Seek(size, soCurrent); 79 | 80 | for i := 0 to 256 - 1 do 81 | begin 82 | ASourceStream.Read(c, 3); 83 | 84 | ADest.Palette.Color[i] := FPColor(word(c.r) shl 8 + c.r, word(c.g) shl 8 + c.g, word(c.b) shl 8 + c.b); 85 | end; 86 | 87 | //load graphics itself 88 | ASourceStream.Seek(initial_pos, soBeginning); 89 | 90 | SetLength(buffer, size); 91 | 92 | ASourceStream.Read(buffer[0], size); 93 | 94 | p := @buffer[0]; 95 | 96 | for i := 0 to height - 1 do 97 | begin 98 | for j := 0 to width - 1 do 99 | begin 100 | ADest.Pixels[j, i] := p^; 101 | inc(p); 102 | end; 103 | end; 104 | finally 105 | ADest.EndUpdate(); 106 | end; 107 | end; 108 | begin 109 | source.Create(ASourceStream); 110 | 111 | size := source.ReadDWord; 112 | width := source.ReadDWord; 113 | height := source.ReadDWord; 114 | 115 | InitBitmap(); 116 | 117 | if size = width * height * 3 then 118 | begin 119 | LoadH3Pcx24(); 120 | end 121 | else if size = width * height then 122 | begin 123 | LoadH3Pcx8(); 124 | end; 125 | end; 126 | 127 | 128 | end. 129 | 130 | -------------------------------------------------------------------------------- /vcmi.lpg: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectGroup FileVersion="1"> 4 | <Targets Count="3"> 5 | <Target0 FileName="3rd_party\opengl\vcmiopenglcontext.lpk"/> 6 | <Target1 FileName="vcmieditor.lpi"> 7 | <BuildModes Count="7"/> 8 | <Mode1 Name="Debug" Compile="True"/> 9 | <Mode2 Name="Release" Compile="True"/> 10 | <Mode3 Name="Profile" Compile="True"/> 11 | <Mode4 Name="ReleaseWin64" Compile="True"/> 12 | <Mode5 Name="DebugWin64" Compile="True"/> 13 | <Mode6 Name="RD" Compile="True"/> 14 | <Mode7 Name="ReleaseWin32"/> 15 | </Target1> 16 | <Target2 FileName="tests\unit_tests.lpi"> 17 | <BuildModes Count="1"/> 18 | <Mode1 Name="Default"/> 19 | </Target2> 20 | </Targets> 21 | </ProjectGroup> 22 | </CONFIG> 23 | -------------------------------------------------------------------------------- /vcmieditor.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vcmi/vcmi_editor/41eeeeb64e7b885b8076750d96634dbda96ac6b6/vcmieditor.ico -------------------------------------------------------------------------------- /vcmieditor.lpr: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2013-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | program vcmieditor; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | uses 22 | {$IFDEF UNIX}{$IFDEF UseCThreads} 23 | cthreads, 24 | {$ENDIF}{$ENDIF} 25 | sysutils, 26 | Interfaces, // this includes the LCL widgetset 27 | Forms, main, root_manager; 28 | 29 | {$R *.res} 30 | 31 | begin 32 | 33 | {$IF DEFINED(VCMI_USE_HEAPTRACE)} 34 | if FileExists('heap.trc') then 35 | DeleteFile('heap.trc'); 36 | SetHeapTraceOutput('heap.trc'); 37 | {$ENDIF} 38 | 39 | Application.Title:='VCMI Editor'; 40 | RequireDerivedFormResource := True; 41 | Application.Initialize; 42 | Application.CreateForm(TRootManager, RootManager); 43 | 44 | if RootManager.BatchMode then 45 | begin 46 | RootManager.RunBatch; 47 | end 48 | else 49 | begin 50 | Application.CreateForm(TfMain, fMain); 51 | Application.Run; 52 | end; 53 | end. 54 | 55 | -------------------------------------------------------------------------------- /zipper_ex.pas: -------------------------------------------------------------------------------- 1 | { This file is a part of Map editor for VCMI project 2 | 3 | Copyright (C) 2016-2017 Alexander Shishkin alexvins@users.sourceforge.net 4 | 5 | This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 6 | License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later 7 | version. 8 | 9 | This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied 10 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | details. 12 | 13 | A copy of the GNU General Public License is available on the World Wide Web at 14 | <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59 15 | Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 | } 17 | unit zipper_ex; 18 | 19 | {$I compilersetup.inc} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, zipper; 25 | 26 | type 27 | 28 | { TUnZipperEx } 29 | 30 | TUnZipperEx = class(TUnZipper) 31 | public 32 | Procedure UnZipOneFile(Item : TFullZipFileEntry); override; 33 | end; 34 | 35 | implementation 36 | 37 | { TUnZipperEx } 38 | 39 | procedure TUnZipperEx.UnZipOneFile(Item: TFullZipFileEntry); 40 | begin 41 | OpenInput; 42 | Try 43 | inherited UnZipOneFile(Item); 44 | finally 45 | CloseInput; 46 | end; 47 | end; 48 | 49 | end. 50 | 51 | --------------------------------------------------------------------------------