├── .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 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
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 |
100 |
101 |
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 | . 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;
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 | . 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 | . 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 | . 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 | . 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 | . 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 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
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 | . 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 | . 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 |
--------------------------------------------------------------------------------