X-Git-Url: https://deadsoftware.ru/gitweb?p=d2df-editor.git;a=blobdiff_plain;f=src%2Feditor%2Ff_main.pas;h=ef9e19d2ee9c59c7ffd0bdeae5e12aedfa9221cc;hp=645e4c1d365bfa0c4139dc1ba123aab2540b4ff4;hb=71ef827e8608f2e426111ff0ddfb7019beba0e65;hpb=1fb1b203de2d204939df9112dda1f72760c956ee

diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index 645e4c1..ef9e19d 100644
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
@@ -1,6 +1,6 @@
 unit f_main;
 
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
 
 interface
 
@@ -8,7 +8,7 @@ uses
   LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics,
   Controls, Forms, Dialogs, ImgList, StdCtrls, Buttons,
   ComCtrls, ValEdit, Types, ToolWin, Menus, ExtCtrls,
-  CheckLst, Grids, OpenGLContext;
+  CheckLst, Grids, OpenGLContext, utils, UTF8Process;
 
 type
 
@@ -207,6 +207,8 @@ type
     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormResize(Sender: TObject);
     procedure lbTextureListClick(Sender: TObject);
+    procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer;
+      ARect: TRect; State: TOwnerDrawState);
     procedure RenderPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     procedure RenderPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
     procedure RenderPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
@@ -258,8 +260,6 @@ type
     procedure OnIdle(Sender: TObject; var Done: Boolean);
   public
     procedure RefreshRecentMenu();
-    { procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer;
-                                    Rect: TRect; State: TOwnerDrawState); }
   end;
 
 const
@@ -1795,6 +1795,7 @@ procedure FullClear();
 begin
   RemoveSelectFromObjects();
   ClearMap();
+  LoadSky(gMapInfo.SkyName);
   UndoBuffer := nil;
   slInvalidTextures.Clear();
   MapCheckForm.lbErrorList.Clear();
@@ -1880,6 +1881,7 @@ var
   ok: Boolean;
   FileName: String;
   ResourceName: String;
+  UResourceName: String;
   FullResourceName: String;
   SectionName: String;
   Data: Pointer;
@@ -1906,19 +1908,20 @@ begin
       end
     else
       begin // Внешний WAD
-        FileName := EditorDir+'wads\'+aWAD;
-        ResourceName := aWAD+':'+SectionName+'\'+aTex;
+        FileName := EditorDir+'wads/'+aWAD;
+        ResourceName := utf2win(aWAD)+':'+SectionName+'\'+aTex;
       end;
 
   ok := True;
+  UResourceName := win2utf(ResourceName);
 
 // Есть ли уже такая текстура:
   for a := 0 to MainForm.lbTextureList.Items.Count-1 do
-    if ResourceName = MainForm.lbTextureList.Items[a] then
+    if UResourceName = MainForm.lbTextureList.Items[a] then
     begin
       if not silent then
         ErrorMessageBox(Format(_lc[I_MSG_TEXTURE_ALREADY],
-                               [ResourceName]));
+                               [UResourceName]));
       ok := False;
     end;
 
@@ -1927,7 +1930,7 @@ begin
   begin
     if not silent then
       ErrorMessageBox(Format(_lc[I_MSG_RES_NAME_64],
-                             [ResourceName]));
+                             [UResourceName]));
     ok := False;
   end;
 
@@ -1936,7 +1939,7 @@ begin
     a := -1;
     if aWAD = _lc[I_WAD_SPECIAL_TEXS] then
     begin
-      a := MainForm.lbTextureList.Items.Add(ResourceName);
+      a := MainForm.lbTextureList.Items.Add(UResourceName);
       if not silent then
         SelectTexture(a);
       Result := True;
@@ -1950,12 +1953,12 @@ begin
         GetFrame(FullResourceName, Data, FrameLen, Width, Height);
 
         if g_CreateTextureMemorySize(Data, FrameLen, ResourceName, 0, 0, Width, Height, 1) then
-          a := MainForm.lbTextureList.Items.Add(ResourceName);
+          a := MainForm.lbTextureList.Items.Add(UResourceName);
       end
     else // Обычная текстура
       begin
         if g_CreateTextureWAD(ResourceName, FullResourceName) then
-          a := MainForm.lbTextureList.Items.Add(ResourceName);
+          a := MainForm.lbTextureList.Items.Add(UResourceName);
       end;
     if (a > -1) and (not silent) then
       SelectTexture(a);
@@ -2044,7 +2047,7 @@ begin
     lbTextureList.Sorted := True;
     lbTextureList.Sorted := False;
 
-    UpdateCaption(gMapInfo.Name, ExtractFileName(FileName), MapName);
+    UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(FileName), MapName);
   end;
 end;
 
@@ -2210,7 +2213,7 @@ end;
 function SelectedTexture(): String;
 begin
   if MainForm.lbTextureList.ItemIndex <> -1 then
-    Result := MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]
+    Result := utf2win(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex])
   else
     Result := '';
 end;
@@ -2218,7 +2221,7 @@ end;
 function IsSpecialTextureSel(): Boolean;
 begin
   Result := (MainForm.lbTextureList.ItemIndex <> -1) and
-            IsSpecialTexture(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]);
+            IsSpecialTexture(utf2win(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]));
 end;
 
 function CopyBufferToString(var CopyBuf: TCopyRecArray): String;
@@ -2498,6 +2501,7 @@ procedure TMainForm.aRecentFileExecute(Sender: TObject);
 var
   n, pw: Integer;
   s, fn: String;
+  b: Boolean;
 begin
   s := LowerCase((Sender as TMenuItem).Caption);
   Delete(s, Pos('&', s), 1);
@@ -2509,17 +2513,31 @@ begin
 
   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;
     end
   else // Only wad name
     if (FileExists(s)) 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;
 end;
 
 procedure TMainForm.aEditorOptionsExecute(Sender: TObject);
@@ -2540,13 +2558,13 @@ begin
   cfglen := 0;
 
   wad := TWADEditor_1.Create;
-  if wad.ReadFile(EditorDir+'data\Game.wad') then
+  if wad.ReadFile(EditorDir+'data/Game.wad') then
     wad.GetResource('FONTS', cfgres, cfgdata, cfglen);
   wad.Free();
 
   if cfglen <> 0 then
   begin
-    if not g_CreateTextureWAD('FONT_STD', EditorDir+'data\Game.wad:FONTS\'+texture) then
+    if not g_CreateTextureWAD('FONT_STD', EditorDir+'data/Game.wad:FONTS\'+texture) then
       e_WriteLog('ERROR ERROR ERROR', MSG_WARNING);
 
     config := TConfig.CreateMem(cfgdata, cfglen);
@@ -2595,8 +2613,16 @@ begin
   OpenedMap := '';
   OpenedWAD := '';
 
-  config := TConfig.CreateFile(EditorDir+'\Editor.cfg');
+  config := TConfig.CreateFile(EditorDir+'Editor.cfg');
 
+  if config.ReadInt('Editor', 'XPos', -1) = -1 then
+    Position := poDesktopCenter
+  else begin
+    Left := config.ReadInt('Editor', 'XPos', Left);
+    Top := config.ReadInt('Editor', 'YPos', Top);
+    Width := config.ReadInt('Editor', 'Width', Width);
+    Height := config.ReadInt('Editor', 'Height', Height);
+  end;
   if config.ReadBool('Editor', 'Maximize', False) then
     WindowState := wsMaximized;
   ShowMap := config.ReadBool('Editor', 'Minimap', False);
@@ -4020,8 +4046,22 @@ var
   config: TConfig;
   i: Integer;
 begin
-  config := TConfig.CreateFile(EditorDir+'\Editor.cfg');
+  config := TConfig.CreateFile(EditorDir+'Editor.cfg');
 
+  if WindowState <> wsMaximized then
+  begin
+    config.WriteInt('Editor', 'XPos', Left);
+    config.WriteInt('Editor', 'YPos', Top);
+    config.WriteInt('Editor', 'Width', Width);
+    config.WriteInt('Editor', 'Height', Height);
+  end
+  else
+  begin
+    config.WriteInt('Editor', 'XPos', RestoredLeft);
+    config.WriteInt('Editor', 'YPos', RestoredTop);
+    config.WriteInt('Editor', 'Width', RestoredWidth);
+    config.WriteInt('Editor', 'Height', RestoredHeight);
+  end;
   config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized);
   config.WriteBool('Editor', 'Minimap', ShowMap);
   config.WriteInt('Editor', 'PanelProps', PanelProps.ClientWidth);
@@ -4043,7 +4083,7 @@ begin
       config.WriteStr('RecentFiles', IntToStr(i+1), '');
   RecentFiles.Free();
 
-  config.SaveFile(EditorDir+'\Editor.cfg');
+  config.SaveFile(EditorDir+'Editor.cfg');
   config.Free();
 
   slInvalidTextures.Free;
@@ -4065,7 +4105,7 @@ begin
   while (Pos(':\', ResName) > 0) do
     Delete(ResName, 1, Pos(':\', ResName) + 1);
 
-  UpdateCaption(gMapInfo.Name, ExtractFileName(OpenedWAD), ResName);
+  UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(OpenedWAD), ResName);
 end;
 
 procedure TMainForm.aAboutExecute(Sender: TObject);
@@ -4286,11 +4326,11 @@ begin
       begin
         AddSoundForm.OKFunction := nil;
         AddSoundForm.lbResourcesList.MultiSelect := False;
-        AddSoundForm.SetResource := vleObjectProperty.Cells[1, i];
+        AddSoundForm.SetResource := utf2win(vleObjectProperty.Cells[1, i]);
 
         if (AddSoundForm.ShowModal() = mrOk) then
         begin
-          vleObjectProperty.Cells[1, i] := AddSoundForm.ResourceName;
+          vleObjectProperty.Cells[1, i] := win2utf(AddSoundForm.ResourceName);
           bApplyProperty.Click();
         end;
         Exit;
@@ -4352,6 +4392,27 @@ begin
     end;
 end;
 
+procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer;
+  ARect: TRect; State: TOwnerDrawState);
+begin
+  with Control as TListBox do
+  begin
+    if LCLType.odSelected in State then
+    begin
+      Canvas.Brush.Color := clHighlight;
+      Canvas.Font.Color := clHighlightText;
+    end else
+      if (Items <> nil) and (Index >= 0) then
+        if slInvalidTextures.IndexOf(Items[Index]) > -1 then
+        begin
+          Canvas.Brush.Color := clRed;
+          Canvas.Font.Color := clWhite;
+        end;
+    Canvas.FillRect(ARect);
+    Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]);
+  end;
+end;
+
 procedure TMainForm.vleObjectPropertyGetPickList(Sender: TObject;
   const KeyName: String; Values: TStrings);
 begin
@@ -5281,8 +5342,8 @@ begin
                   begin
                     Panel^.TextureID := SpecialTextureID(Panel^.TextureName);
                     with MainForm.lbTextureList.Items do
-                      if IndexOf(Panel^.TextureName) = -1 then
-                        Add(Panel^.TextureName);
+                      if IndexOf(win2utf(Panel^.TextureName)) = -1 then
+                        Add(win2utf(Panel^.TextureName));
                   end;
               end;
 
@@ -5443,11 +5504,11 @@ begin
     begin // Выбор файла звука/музыки:
       AddSoundForm.OKFunction := nil;
       AddSoundForm.lbResourcesList.MultiSelect := False;
-      AddSoundForm.SetResource := vleObjectProperty.Values[Key];
+      AddSoundForm.SetResource := utf2win(vleObjectProperty.Values[Key]);
 
       if (AddSoundForm.ShowModal() = mrOk) then
       begin
-        vleObjectProperty.Values[Key] := AddSoundForm.ResourceName;
+        vleObjectProperty.Values[Key] := utf2win(AddSoundForm.ResourceName);
         bApplyProperty.Click();
       end;
     end
@@ -5751,9 +5812,9 @@ begin
       else gLanguage := LANGUAGE_RUSSIAN;
     end;
 
-    config := TConfig.CreateFile(EditorDir+'\Editor.cfg');
+    config := TConfig.CreateFile(EditorDir+'Editor.cfg');
     config.WriteStr('Editor', 'Language', gLanguage);
-    config.SaveFile(EditorDir+'\Editor.cfg');
+    config.SaveFile(EditorDir+'Editor.cfg');
     config.Free();
   end;
 
@@ -6004,7 +6065,7 @@ begin
 
   gMapInfo.FileName := SaveDialog.FileName;
   gMapInfo.MapName := SaveMapForm.eMapName.Text;
-  UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName);
+  UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(gMapInfo.FileName), gMapInfo.MapName);
 end;
 
 procedure TMainForm.aSelectAllExecute(Sender: TObject);
@@ -6057,7 +6118,9 @@ begin
     e_InitGL();
     e_WriteLog('Loading data', MSG_NOTIFY);
     LoadStdFont('STDTXT', 'STDFONT', gEditorFont);
+    e_WriteLog('Loading more data', MSG_NOTIFY);
     LoadData();
+    e_WriteLog('Loading even more data', MSG_NOTIFY);
     gDataLoaded := True;
     MainForm.FormResize(nil);
   end;
@@ -6091,6 +6154,8 @@ begin
 
   PreviewMode := not PreviewMode;
   (Sender as TMenuItem).Checked := PreviewMode;
+
+  FormResize(Self);
 end;
 
 procedure TMainForm.miLayer1Click(Sender: TObject);
@@ -6223,21 +6288,33 @@ end;
 
 procedure TMainForm.miTestMapClick(Sender: TObject);
 var
-  cmd, mapWAD, mapToRun: String;
+  cmd, mapWAD, mapToRun, tempWAD: String;
   opt: LongWord;
   time: Integer;
-  lpMsgBuf: PChar;
+  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;
   // Сохраняем временную карту:
   time := 0;
   repeat
-    mapWAD := ExtractFilePath(TestD2dExe) + Format('maps\temp%.4d.wad', [time]);
+    mapWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d.wad', [time]);
     Inc(time);
   until not FileExists(mapWAD);
-  mapToRun := mapWAD + ':\' + TEST_MAP_NAME;
-  SaveMap(mapToRun);
+  tempWAD := mapWAD + ':\' + TEST_MAP_NAME;
+  SaveMap(tempWAD);
 
-  mapToRun := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps\', mapToRun);
+  tempWAD := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', tempWAD);
+// Если карта не была открыта, указываем временную в качестве текущей:
+  if mapToRun = '' then
+    mapToRun := tempWAD;
 
 // Опции игры:
   opt := 32 + 64;
@@ -6253,7 +6330,8 @@ begin
     opt := opt + 16;
 
 // Составляем командную строку:
-  cmd := ' -map "' + mapToRun + '"';
+  cmd := '-map "' + mapToRun + '"';
+  cmd := cmd + ' -testmap "' + tempWAD + '"';
   cmd := cmd + ' -gm ' + TestGameMode;
   cmd := cmd + ' -limt ' + TestLimTime;
   cmd := cmd + ' -lims ' + TestLimScore;
@@ -6263,16 +6341,29 @@ begin
     cmd := cmd + ' --close';
 
   cmd := cmd + ' --debug';
-  cmd := cmd + ' --tempdelete';
 
 // Запускаем:
-  Application.Minimize();
-  if ExecuteProcess(TestD2dExe, cmd) < 0 then
+  proc := TProcessUTF8.Create(nil);
+  proc.Executable := TestD2dExe;
+  proc.Parameters.Add(cmd);
+  res := True;
+  try
+    proc.Execute();
+  except
+    res := False;
+  end;
+  if res then
+  begin
+    Application.Minimize();
+    proc.WaitOnExit();
+  end;
+  if (not res) or (proc.ExitCode < 0) then
   begin
     MessageBox(0, 'FIXME',
                PChar(_lc[I_MSG_EXEC_ERROR]),
                MB_OK or MB_ICONERROR);
   end;
+  proc.Free();
 
   SysUtils.DeleteFile(mapWAD);
   Application.Restore();
@@ -6367,26 +6458,4 @@ begin
   end;
 end;
 
-{
-procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer;
-      Rect: TRect; State: LCLType.TOwnerDrawState);
-begin
-  with Control as TListBox do
-  begin
-    if LCLType.odSelected in State then
-    begin
-      Canvas.Brush.Color := clHighlight;
-      Canvas.Font.Color := clHighlightText;
-    end else
-      if (Items <> nil) and (Index >= 0) then
-        if slInvalidTextures.IndexOf(Items[Index]) > -1 then
-        begin
-          Canvas.Brush.Color := clRed;
-          Canvas.Font.Color := clWhite;
-        end;
-    Canvas.FillRect(Rect);
-    Canvas.TextRect(Rect, Rect.Left, Rect.Top, Items[Index]);
-  end;
-end;
-}
 end.