diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index 7282c785c430a7a5342aa2f6e52a2821e14413d1..5fbd3607212f2c5d05c74a6a5ea1283fcbba5bb9 100644 (file)
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
miMapOptions: TMenuItem;
miLine6: TMenuItem;
miOptions: TMenuItem;
- miLine7: TMenuItem;
- miMapTestSettings: TMenuItem;
// "Справка":
miMenuHelp: TMenuItem;
miAbout: TMenuItem;
miLayerP7: TMenuItem;
miLayerP8: TMenuItem;
miLayerP9: TMenuItem;
- // Всплывающее меню для кнопки теста карты:
- pmMapTest: TPopupMenu;
- miMapTestPMSet: TMenuItem;
// Панель карты:
PanelMap: TPanel;
// Панель применения свойств:
PanelPropApply: TPanel;
bApplyProperty: TButton;
+ MapTestTimer: TTimer;
// Редактор свойств объектов:
vleObjectProperty: TValueListEditor;
procedure RenderPanelPaint(Sender: TObject);
procedure RenderPanelResize(Sender: TObject);
procedure Splitter1Moved(Sender: TObject);
+ procedure MapTestCheck(Sender: TObject);
procedure vleObjectPropertyEditButtonClick(Sender: TObject);
procedure vleObjectPropertyApply(Sender: TObject);
procedure vleObjectPropertyGetPickList(Sender: TObject; const KeyName: String; Values: TStrings);
procedure bClearTextureClick(Sender: TObject);
procedure miPackMapClick(Sender: TObject);
procedure aRecentFileExecute(Sender: TObject);
- procedure miMapTestSettingsClick(Sender: TObject);
procedure miTestMapClick(Sender: TObject);
procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
var
MainForm: TMainForm;
- EditorDir: String;
+ StartMap: String;
OpenedMap: String;
OpenedWAD: String;
f_options, e_graphics, e_log, GL, Math,
f_mapoptions, g_basic, f_about, f_mapoptimization,
f_mapcheck, f_addresource_texture, g_textures,
- f_activationtype, f_keys,
+ f_activationtype, f_keys, wadreader, fileutil,
MAPREADER, f_selectmap, f_savemap, WADEDITOR, MAPDEF,
g_map, f_saveminimap, f_addresource, CONFIG, f_packmap,
- f_addresource_sound, f_maptest, f_choosetype,
- g_language, f_selectlang, ClipBrd, g_resources;
+ f_addresource_sound, f_choosetype,
+ g_language, f_selectlang, ClipBrd, g_resources, g_options;
const
UNDO_DELETE_PANEL = 1;
LastMovePoint: Types.TPoint;
MouseLDown: Boolean;
MouseRDown: Boolean;
+ MouseMDown: Boolean;
MouseLDownPos: Types.TPoint;
MouseRDownPos: Types.TPoint;
+ MouseMDownPos: Types.TPoint;
SelectFlag: Byte = SELECTFLAG_NONE;
MouseAction: Byte = MOUSEACTION_NONE;
UndoBuffer: Array of Array of TUndoRec = nil;
+ MapTestProcess: TProcessUTF8;
+ MapTestFile: String;
{$R *.lfm}
MapOffset.X := MapOffset.X - rx;
MapOffset.Y := MapOffset.Y - ry;
// Выход за границы:
- if MapOffset.X < MainForm.sbHorizontal.Min then
- MapOffset.X := MainForm.sbHorizontal.Min;
- if MapOffset.Y < MainForm.sbVertical.Min then
- MapOffset.Y := MainForm.sbVertical.Min;
- if MapOffset.X > MainForm.sbHorizontal.Max then
- MapOffset.X := MainForm.sbHorizontal.Max;
- if MapOffset.Y > MainForm.sbVertical.Max then
- MapOffset.Y := MainForm.sbVertical.Max;
+ MapOffset.X := EnsureRange(MapOffset.X, MainForm.sbHorizontal.Min, MainForm.sbHorizontal.Max);
+ MapOffset.Y := EnsureRange(MapOffset.Y, MainForm.sbVertical.Min, MainForm.sbVertical.Max);
// Кратно 16:
// MapOffset.X := Normalize16(MapOffset.X);
// MapOffset.Y := Normalize16(MapOffset.Y);
procedure ErrorMessageBox(str: String);
begin
- MessageBox(0, PChar(str), PChar(_lc[I_MSG_ERROR]),
+ Application.MessageBox(PChar(str), PChar(_lc[I_MSG_ERROR]),
MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);
end;
if aWAD = _lc[I_WAD_SPECIAL_MAP] then
begin // Файл карты
g_ProcessResourceStr(OpenedMap, @fn, nil, nil);
- //FileName := EditorDir+'maps\'+ExtractFileName(fn);
FileName := fn;
ResourceName := ':'+SectionName+'\'+aTex;
end
end
else
begin // Внешний WAD
- FileName := EditorDir+'wads/'+aWAD;
+ FileName := WadsDir + DirectorySeparator + aWAD;
ResourceName := aWAD+':'+SectionName+'\'+aTex;
end;
procedure TMainForm.aRecentFileExecute(Sender: TObject);
var
- n, pw: Integer;
- s, fn: String;
- b: Boolean;
+ n: Integer;
+ fn, s: String;
begin
s := LowerCase((Sender as TMenuItem).Caption);
Delete(s, Pos('&', s), 1);
s := Trim(Copy(s, 1, 2));
n := StrToIntDef(s, 0) - 1;
-
- if (n < 0) or (n >= RecentFiles.Count) then
- Exit;
-
- s := RecentFiles[n];
- pw := Pos('.wad:\', LowerCase(s));
- b := False;
-
- if pw > 0 then
- begin // Map name included
- fn := Copy(s, 1, pw + 3);
- Delete(s, 1, pw + 5);
- if (FileExists(fn)) then
- begin
- OpenMap(fn, s);
- b := True;
- end;
+ if (n >= 0) and (n <= RecentFiles.Count) then
+ begin
+ fn := g_ExtractWadName(RecentFiles[n]);
+ if FileExists(fn) then
+ begin
+ s := g_ExtractFilePathName(RecentFiles[n]);
+ OpenMap(fn, s)
end
- else // Only wad name
- if (FileExists(s)) then
+ else if Application.MessageBox(PChar(_lc[I_MSG_DEL_RECENT_PROMT]), PChar(_lc[I_MSG_DEL_RECENT]), MB_ICONQUESTION or MB_YESNO) = idYes then
begin
- OpenMap(s, '');
- b := True;
- end;
-
- if (not b) and (MessageBox(0, PChar(_lc[I_MSG_DEL_RECENT_PROMT]),
- PChar(_lc[I_MSG_DEL_RECENT]), MB_ICONQUESTION or MB_YESNO) = idYes) then
- begin
- RecentFiles.Delete(n);
- RefreshRecentMenu();
- end;
+ RecentFiles.Delete(n);
+ RefreshRecentMenu();
+ end
+ end
end;
procedure TMainForm.aEditorOptionsExecute(Sender: TObject);
config: TConfig;
begin
ID := 0;
- g_ReadResource(EditorDir + 'data/game.wad', 'FONTS', cfgres, cfgdata, cfglen);
+ g_ReadResource(GameWad, 'FONTS', cfgres, cfgdata, cfglen);
if cfgdata <> nil then
begin
- if not g_CreateTextureWAD('FONT_STD', EditorDir + 'data/game.wad:FONTS\' + texture) then
+ if not g_CreateTextureWAD('FONT_STD', GameWad + ':FONTS\' + texture) then
e_WriteLog('ERROR ERROR ERROR', MSG_WARNING);
config := TConfig.CreateMem(cfgdata, cfglen);
begin
Randomize();
- EditorDir := ExtractFilePath(Application.ExeName);
-
- e_InitLog(EditorDir+'Editor.log', WM_NEWFILE);
+ e_WriteLog('Doom 2D: Forever Editor version ' + EDITOR_VERSION, MSG_NOTIFY);
+ e_WriteLog('Build date: ' + EDITOR_BUILDDATE + ' ' + EDITOR_BUILDTIME, MSG_NOTIFY);
+ e_WriteLog('Build hash: ' + g_GetBuildHash(), MSG_NOTIFY);
+ e_WriteLog('Build by: ' + g_GetBuilderName(), MSG_NOTIFY);
slInvalidTextures := TStringList.Create;
OpenedMap := '';
OpenedWAD := '';
- config := TConfig.CreateFile(EditorDir+'Editor.cfg');
+ config := TConfig.CreateFile(CfgFileName);
if config.ReadInt('Editor', 'XPos', -1) = -1 then
Position := poDesktopCenter
DotSize := 2
else
DotSize := 1;
- OpenDialog.InitialDir := config.ReadStr('Editor', 'LastOpenDir', EditorDir);
- SaveDialog.InitialDir := config.ReadStr('Editor', 'LastSaveDir', EditorDir);
+ OpenDialog.InitialDir := config.ReadStr('Editor', 'LastOpenDir', MapsDir);
+ SaveDialog.InitialDir := config.ReadStr('Editor', 'LastSaveDir', MapsDir);
s := config.ReadStr('Editor', 'Language', '');
gLanguage := s;
Compress := config.ReadBool('Editor', 'Compress', True);
Backup := config.ReadBool('Editor', 'Backup', True);
+ TestGameMode := config.ReadStr('TestRun', 'GameMode', 'DM');
+ TestLimTime := config.ReadStr('TestRun', 'LimTime', '0');
+ TestLimScore := config.ReadStr('TestRun', 'LimScore', '0');
+ TestOptionsTwoPlayers := config.ReadBool('TestRun', 'TwoPlayers', False);
+ TestOptionsTeamDamage := config.ReadBool('TestRun', 'TeamDamage', False);
+ TestOptionsAllowExit := config.ReadBool('TestRun', 'AllowExit', True);
+ TestOptionsWeaponStay := config.ReadBool('TestRun', 'WeaponStay', False);
+ TestOptionsMonstersDM := config.ReadBool('TestRun', 'MonstersDM', False);
+ TestMapOnce := config.ReadBool('TestRun', 'MapOnce', False);
+ {$IF DEFINED(DARWIN)}
+ TestD2dExe := config.ReadStr('TestRun', 'ExeDrawin', GameExeFile);
+ {$ELSEIF DEFINED(WINDOWS)}
+ TestD2dExe := config.ReadStr('TestRun', 'ExeWindows', GameExeFile);
+ {$ELSE}
+ TestD2dExe := config.ReadStr('TestRun', 'ExeUnix', GameExeFile);
+ {$ENDIF}
+ TestD2DArgs := config.ReadStr('TestRun', 'Args', '');
+
RecentCount := config.ReadInt('Editor', 'RecentCount', 5);
if RecentCount > 10 then
RecentCount := 10;
end;
end; // if Button = mbRight
+ if Button = mbMiddle then // Middle Mouse Button
+ begin
+ SetCapture(RenderPanel.Handle);
+ RenderPanel.Cursor := crSize;
+ end;
+
+ MouseMDown := Button = mbMiddle;
+ if MouseMDown then
+ MouseMDownPos := Mouse.CursorPos;
+
MouseRDown := Button = mbRight;
if MouseRDown then
MouseRDownPos := MousePos;
MouseLDown := False;
if Button = mbRight then
MouseRDown := False;
+ if Button = mbMiddle then
+ MouseMDown := False;
DrawRect := nil;
ResizeType := RESIZETYPE_NONE;
MouseAction := MOUSEACTION_NONE;
end;
end // if Button = mbLeft...
- else // Right Mouse Button:
+ else if Button = mbRight then // Right Mouse Button:
begin
if MouseAction = MOUSEACTION_NOACTION then
begin
// Объект передвинут или изменен в размере:
if MouseAction in [MOUSEACTION_MOVEOBJ, MOUSEACTION_RESIZE] then
begin
+ RenderPanel.Cursor := crDefault;
MouseAction := MOUSEACTION_NONE;
FillProperty();
Exit;
SelectObjects(pcObjects.ActivePageIndex+1);
FillProperty();
+ end
+
+ else // Middle Mouse Button
+ begin
+ RenderPanel.Cursor := crDefault;
+ ReleaseCapture();
end;
end;
MousePos.Y := Round((-MapOffset.Y + Y) / sY) * sY + MapOffset.Y;
end;
-// Изменение размера закончилось - ставим обычный курсор:
- if ResizeType = RESIZETYPE_NONE then
- RenderPanel.Cursor := crDefault;
-
// Зажата только правая кнопка мыши:
- if (not MouseLDown) and (MouseRDown) then
+ if (not MouseLDown) and (MouseRDown) and (not MouseMDown) then
begin
// Рисуем прямоугольник выделения:
if MouseAction = MOUSEACTION_NONE then
end;
// Зажата только левая кнопка мыши:
- if (not MouseRDown) and (MouseLDown) then
+ if (not MouseRDown) and (MouseLDown) and (not MouseMDown) then
begin
// Рисуем прямоугольник планирования панели:
if MouseAction in [MOUSEACTION_DRAWPANEL,
end;
end;
+// Only Middle Mouse Button is pressed
+ if (not MouseLDown) and (not MouseRDown) and (MouseMDown) then
+ begin
+ MapOffset.X := -EnsureRange(-MapOffset.X + MouseMDownPos.X - Mouse.CursorPos.X,
+ sbHorizontal.Min, sbHorizontal.Max);
+ sbHorizontal.Position := -MapOffset.X;
+ MapOffset.Y := -EnsureRange(-MapOffset.Y + MouseMDownPos.Y - Mouse.CursorPos.Y,
+ sbVertical.Min, sbVertical.Max);
+ sbVertical.Position := -MapOffset.Y;
+ MouseMDownPos := Mouse.CursorPos;
+ end;
+
// Клавиши мыши не зажаты:
if (not MouseRDown) and (not MouseLDown) then
DrawRect := nil;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
- CanClose := MessageBox(0, PChar(_lc[I_MSG_EXIT_PROMT]),
+ CanClose := Application.MessageBox(PChar(_lc[I_MSG_EXIT_PROMT]),
PChar(_lc[I_MSG_EXIT]),
MB_ICONQUESTION or MB_YESNO or
MB_DEFBUTTON1) = idYes;
config: TConfig;
i: Integer;
begin
- config := TConfig.CreateFile(EditorDir+'Editor.cfg');
+ config := TConfig.CreateFile(CfgFileName);
if WindowState <> wsMaximized then
begin
config.WriteStr('RecentFiles', IntToStr(i+1), '');
RecentFiles.Free();
- config.SaveFile(EditorDir+'Editor.cfg');
+ config.SaveFile(CfgFileName);
config.Free();
slInvalidTextures.Free;
FormResize(Sender);
end;
+procedure TMainForm.MapTestCheck(Sender: TObject);
+begin
+ if MapTestProcess <> nil then
+ begin
+ if MapTestProcess.Running = false then
+ begin
+ if MapTestProcess.ExitCode <> 0 then
+ Application.MessageBox(PChar(_lc[I_MSG_EXEC_ERROR]), 'FIXME', MB_OK or MB_ICONERROR);
+ SysUtils.DeleteFile(MapTestFile);
+ MapTestFile := '';
+ FreeAndNil(MapTestProcess);
+ tbTestMap.Enabled := True;
+ end;
+ end;
+end;
+
procedure TMainForm.aMapOptionsExecute(Sender: TObject);
var
ResName: String;
if OpenedMap = '' then
Exit;
- if MessageBox(0, PChar(_lc[I_MSG_REOPEN_MAP_PROMT]),
+ if Application.MessageBox(PChar(_lc[I_MSG_REOPEN_MAP_PROMT]),
PChar(_lc[I_MENU_FILE_REOPEN]), MB_ICONQUESTION or MB_YESNO) <> idYes then
Exit;
if vleObjectProperty.Values[_lc[I_PROP_TR_MUSIC_ACT]] = _lc[I_PROP_TR_MUSIC_ON] then
Data.MusicAction := 1
else
- Data.MusicAction := 2;
+ Data.MusicAction := 0;
end;
TRIGGER_PUSH:
if i = -1 then
Exit;
- if MessageBox(0, PChar(Format(_lc[I_MSG_DEL_TEXTURE_PROMT],
+ if Application.MessageBox(PChar(Format(_lc[I_MSG_DEL_TEXTURE_PROMT],
[SelectedTexture()])),
PChar(_lc[I_MSG_DEL_TEXTURE]),
MB_ICONQUESTION or MB_YESNO or
procedure TMainForm.aNewMapExecute(Sender: TObject);
begin
- if (MessageBox(0, PChar(_lc[I_MSG_CLEAR_MAP_PROMT]),
- PChar(_lc[I_MSG_CLEAR_MAP]),
- MB_ICONQUESTION or MB_YESNO or
- MB_DEFBUTTON1) = mrYes) then
+ if Application.MessageBox(PChar(_lc[I_MSG_CLEAR_MAP_PROMT]), PChar(_lc[I_MSG_CLEAR_MAP]), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON1) = mrYes then
FullClear();
end;
MainForm.ActiveControl := RenderPanel;
// Язык:
- if gLanguage = '' then
+ if (gLanguage = '') and not (fsModal in SelectLanguageForm.FormState) then
begin
lang := SelectLanguageForm.ShowModal();
case lang of
1: gLanguage := LANGUAGE_ENGLISH;
- else gLanguage := LANGUAGE_RUSSIAN;
+ 2: gLanguage := LANGUAGE_RUSSIAN;
+ else gLanguage := LANGUAGE_ENGLISH;
end;
- config := TConfig.CreateFile(EditorDir+'Editor.cfg');
+ config := TConfig.CreateFile(CfgFileName);
config.WriteStr('Editor', 'Language', gLanguage);
- config.SaveFile(EditorDir+'Editor.cfg');
+ config.SaveFile(CfgFileName);
config.Free();
end;
Exit;
MapName := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
- if MessageBox(0, PChar(Format(_lc[I_MSG_DELETE_MAP_PROMT], [MapName, OpenDialog.FileName])), PChar(_lc[I_MSG_DELETE_MAP]), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then
+ if Application.MessageBox(PChar(Format(_lc[I_MSG_DELETE_MAP_PROMT], [MapName, OpenDialog.FileName])), PChar(_lc[I_MSG_DELETE_MAP]), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then
Exit;
g_DeleteResource(FileName, '', MapName, res);
if res <> 0 then
begin
- MessageBox(0, PChar('Cant delete map res=' + IntToStr(res)), PChar('Map not deleted!'), MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);
+ Application.MessageBox(PChar('Cant delete map res=' + IntToStr(res)), PChar('Map not deleted!'), MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);
Exit
end;
- MessageBox(
- 0,
+ Application.MessageBox(
PChar(Format(_lc[I_MSG_MAP_DELETED_PROMT], [MapName])),
PChar(_lc[I_MSG_MAP_DELETED]),
MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1
end;
procedure TMainForm.OnIdle(Sender: TObject; var Done: Boolean);
+ var f: AnsiString;
begin
// FIXME: this is a shitty hack
if not gDataLoaded then
MainForm.FormResize(nil);
end;
Draw();
+ if StartMap <> '' then
+ begin
+ f := StartMap;
+ StartMap := '';
+ OpenMap(f, '');
+ end;
end;
procedure TMainForm.miMapPreviewClick(Sender: TObject);
PackMapForm.ShowModal();
end;
-procedure TMainForm.miMapTestSettingsClick(Sender: TObject);
-begin
- MapTestForm.ShowModal();
-end;
-
type SSArray = array of String;
function ParseString (Str: AnsiString): SSArray;
procedure TMainForm.miTestMapClick(Sender: TObject);
var
- mapWAD, mapToRun, tempWAD: String;
+ newWAD, oldWAD, tempMap, ext: String;
args: SSArray;
opt: LongWord;
time, i: Integer;
proc: TProcessUTF8;
res: Boolean;
begin
- mapToRun := '';
- if OpenedMap <> '' then
- begin
- // Указываем текущую карту для теста:
- g_ProcessResourceStr(OpenedMap, @mapWAD, nil, @mapToRun);
- mapToRun := mapWAD + ':\' + mapToRun;
- mapToRun := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', mapToRun);
- end;
+ // Ignore while map testing in progress
+ if MapTestProcess <> nil then
+ Exit;
+
// Сохраняем временную карту:
time := 0;
repeat
- mapWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d.wad', [time]);
+ newWAD := Format('%s/temp%.4d', [MapsDir, time]);
Inc(time);
- until not FileExists(mapWAD);
- tempWAD := mapWAD + ':\' + TEST_MAP_NAME;
- SaveMap(tempWAD);
-
- tempWAD := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', tempWAD);
-// Если карта не была открыта, указываем временную в качестве текущей:
- if mapToRun = '' then
- mapToRun := tempWAD;
+ until not FileExists(newWAD);
+ if OpenedMap <> '' then
+ begin
+ oldWad := g_ExtractWadName(OpenedMap);
+ newWad := newWad + ExtractFileExt(oldWad);
+ if CopyFile(oldWad, newWad) = false then
+ e_WriteLog('MapTest: unable to copy [' + oldWad + '] to [' + newWad + ']', MSG_WARNING)
+ end
+ else
+ begin
+ newWad := newWad + '.wad'
+ end;
+ tempMap := newWAD + ':\' + TEST_MAP_NAME;
+ SaveMap(tempMap);
// Опции игры:
opt := 32 + 64;
// Запускаем:
proc := TProcessUTF8.Create(nil);
proc.Executable := TestD2dExe;
+ {$IFDEF DARWIN}
+ // TODO: get real executable name from Info.plist
+ if LowerCase(ExtractFileExt(TestD2dExe)) = '.app' then
+ proc.Executable := TestD2dExe + DirectorySeparator + 'Contents' + DirectorySeparator + 'MacOS' + DirectorySeparator + 'Doom2DF';
+ {$ENDIF}
proc.Parameters.Add('-map');
- proc.Parameters.Add(mapToRun);
- proc.Parameters.Add('-testmap');
- proc.Parameters.Add(tempWAD);
+ proc.Parameters.Add(tempMap);
proc.Parameters.Add('-gm');
proc.Parameters.Add(TestGameMode);
proc.Parameters.Add('-limt');
end;
if res then
begin
- Application.Minimize();
- proc.WaitOnExit();
- end;
- if (not res) or (proc.ExitCode < 0) then
+ tbTestMap.Enabled := False;
+ MapTestFile := newWAD;
+ MapTestProcess := proc;
+ end
+ else
begin
- MessageBox(0, 'FIXME',
- PChar(_lc[I_MSG_EXEC_ERROR]),
- MB_OK or MB_ICONERROR);
+ Application.MessageBox(PChar(_lc[I_MSG_EXEC_ERROR]), 'FIXME', MB_OK or MB_ICONERROR);
+ SysUtils.DeleteFile(newWAD);
+ proc.Free();
end;
- proc.Free();
-
- SysUtils.DeleteFile(mapWAD);
- Application.Restore();
end;
procedure TMainForm.sbVerticalScroll(Sender: TObject;