test: fix error message on launch fail

[d2df-editor.git] / src / editor / f_main.pas

diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index 4498ee9efd55146bcab5e8b00205ed86bb668d16..be9dee3915e746363fd9c91ff7fd9b22abb05ab5 100644 (file)
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
@@ -124,6 +124,7 @@ type
   // Панель применения свойств:
     PanelPropApply: TPanel;
     bApplyProperty: TButton;
+    MapTestTimer: TTimer;
   // Редактор свойств объектов:
     vleObjectProperty: TValueListEditor;
 
@@ -218,6 +219,7 @@ type
     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);
@@ -286,7 +288,7 @@ const
 
 var
   MainForm: TMainForm;
-  EditorDir: String;
+  StartMap: String;
   OpenedMap: String;
   OpenedWAD: String;
 
@@ -337,11 +339,11 @@ uses
   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, wadreader,
+  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;
+  g_language, f_selectlang, ClipBrd, g_resources, g_options;
 
 const
   UNDO_DELETE_PANEL   = 1;
@@ -457,6 +459,8 @@ var
 
   UndoBuffer: Array of Array of TUndoRec = nil;
 
+  MapTestProcess: TProcessUTF8;
+  MapTestFile: String;
 
 {$R *.lfm}
 
@@ -2617,10 +2621,10 @@ var
   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);
@@ -2648,9 +2652,10 @@ var
 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;
 
@@ -2670,7 +2675,7 @@ begin
   OpenedMap := '';
   OpenedWAD := '';
 
-  config := TConfig.CreateFile(EditorDir+'Editor.cfg');
+  config := TConfig.CreateFile(CfgFileName);
 
   if config.ReadInt('Editor', 'XPos', -1) = -1 then
     Position := poDesktopCenter
@@ -4235,7 +4240,7 @@ var
   config: TConfig;
   i: Integer;
 begin
-  config := TConfig.CreateFile(EditorDir+'Editor.cfg');
+  config := TConfig.CreateFile(CfgFileName);
 
   if WindowState <> wsMaximized then
   begin
@@ -4274,7 +4279,7 @@ begin
       config.WriteStr('RecentFiles', IntToStr(i+1), '');
   RecentFiles.Free();
 
-  config.SaveFile(EditorDir+'Editor.cfg');
+  config.SaveFile(CfgFileName);
   config.Free();
 
   slInvalidTextures.Free;
@@ -4300,6 +4305,22 @@ begin
   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;
@@ -5151,7 +5172,7 @@ begin
                 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:
@@ -6232,9 +6253,9 @@ begin
       else gLanguage := LANGUAGE_RUSSIAN;
     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;
 
@@ -6512,6 +6533,7 @@ begin
 end;
 
 procedure TMainForm.OnIdle(Sender: TObject; var Done: Boolean);
+  var f: AnsiString;
 begin
   // FIXME: this is a shitty hack
   if not gDataLoaded then
@@ -6527,6 +6549,12 @@ begin
     MainForm.FormResize(nil);
   end;
   Draw();
+  if StartMap <> '' then
+  begin
+    f := StartMap;
+    StartMap := '';
+    OpenMap(f, '');
+  end;
 end;
 
 procedure TMainForm.miMapPreviewClick(Sender: TObject);
@@ -6728,22 +6756,37 @@ end;
 
 procedure TMainForm.miTestMapClick(Sender: TObject);
 var
-  mapWAD, tempWAD: String;
+  newWAD, oldWAD, tempMap, ext: String;
   args: SSArray;
   opt: LongWord;
   time, i: Integer;
   proc: TProcessUTF8;
   res: Boolean;
 begin
+  // Ignore while map testing in progress
+  if MapTestProcess <> nil then
+    Exit;
+
   // Сохраняем временную карту:
   time := 0;
   repeat
-    mapWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d.wad', [time]);
+    newWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d', [time]);
     Inc(time);
-  until not FileExists(mapWAD);
-  tempWAD := mapWAD + ':\' + TEST_MAP_NAME;
-  SaveMap(tempWAD);
-  tempWAD := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', 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);
+  tempMap := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', tempMap);
 
 // Опции игры:
   opt := 32 + 64;
@@ -6762,9 +6805,7 @@ begin
   proc := TProcessUTF8.Create(nil);
   proc.Executable := TestD2dExe;
   proc.Parameters.Add('-map');
-  proc.Parameters.Add(tempWAD);
-  proc.Parameters.Add('-testmap');
-  proc.Parameters.Add(tempWAD);
+  proc.Parameters.Add(tempMap);
   proc.Parameters.Add('-gm');
   proc.Parameters.Add(TestGameMode);
   proc.Parameters.Add('-limt');
@@ -6789,19 +6830,16 @@ begin
   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;