DEADSOFTWARE

Fix memory leaks in the recent files menu code and simplify it
[d2df-editor.git] / src / editor / f_main.pas
index 86ec6b4f7681bfe84d94c061e20eaaeeea963337..5d8635099881daf655c9a2c27798bd14e8971b1c 100644 (file)
@@ -15,33 +15,44 @@ type
   { TMainForm }
 
   TMainForm = class(TForm)
-    lLoad: TLabel;
-  // Главное меню:
+    MapTestTimer: TTimer;
+    Splitter1: TSplitter;
+    Splitter2: TSplitter;
+    StatusBar: TStatusBar;
+    OpenDialog: TOpenDialog;
+    SaveDialog: TSaveDialog;
+    ColorDialog: TColorDialog;
+
+  // Menu:
     MainMenu: TMainMenu;
+    ImageList: TImageList;
   // Apple menu:
     miApple: TMenuItem;
     miAppleAbout: TMenuItem;
     miAppleLine0: TMenuItem;
     miApplePref: TMenuItem;
     miAppleLine1: TMenuItem;
-  // "Файл":
+  // File menu:
     miMenuFile: TMenuItem;
     miNewMap: TMenuItem;
     miOpenMap: TMenuItem;
-    miSaveMap: TMenuItem;
-    miSaveMapAs: TMenuItem;
     miMacRecentSubMenu: TMenuItem;
+    miMacRecentEnd: TMenuItem;
     miMacRecentClear: TMenuItem;
+    Separator1: TMenuItem;
+    miSaveMap: TMenuItem;
+    miSaveMapAs: TMenuItem;
     miOpenWadMap: TMenuItem;
     miLine1: TMenuItem;
     miReopenMap: TMenuItem;
     miSaveMiniMap: TMenuItem;
     miDeleteMap: TMenuItem;
     miPackMap: TMenuItem;
+    miWinRecentStart: TMenuItem;
     miWinRecent: TMenuItem;
     miLine2: TMenuItem;
     miExit: TMenuItem;
-  // "Правка":
+  // Edit menu:
     miMenuEdit: TMenuItem;
     miUndo: TMenuItem;
     miLine3: TMenuItem;
@@ -51,11 +62,16 @@ type
     miLine4: TMenuItem;
     miSelectAll: TMenuItem;
     miLine5: TMenuItem;
+    miSnapToGrid: TMenuItem;
+    miSwitchGrid: TMenuItem;
+    Separator2: TMenuItem;
     miToFore: TMenuItem;
     miToBack: TMenuItem;
+    miLine6: TMenuItem;
+    miMapOptions: TMenuItem;
+    miOptions: TMenuItem;
   // View menu:
     miMenuView: TMenuItem;
-    miShowEdges: TMenuItem;
     miLayers: TMenuItem;
     miLayer1: TMenuItem;
     miLayer2: TMenuItem;
@@ -68,14 +84,10 @@ type
     miLayer9: TMenuItem;
     miViewLine1: TMenuItem;
     miMiniMap: TMenuItem;
+    miShowEdges: TMenuItem;
     miViewLine2: TMenuItem;
     miMapPreview: TMenuItem;
-    miSnapToGrid: TMenuItem;
-    miSwitchGrid: TMenuItem;
-    miLine6: TMenuItem;
-    miOptions: TMenuItem;
-    miMapOptions: TMenuItem;
-  // "Сервис":
+  // Service menu:
     miMenuService: TMenuItem;
     miCheckMap: TMenuItem;
     miOptimmization: TMenuItem;
@@ -84,22 +96,17 @@ type
     miMenuWindow: TMenuItem;
     miMacMinimize: TMenuItem;
     miMacZoom: TMenuItem;
-  // "Справка":
+  // Help Menu:
     miMenuHelp: TMenuItem;
     miAbout: TMenuItem;
-  // Скрытый пункт меню для Ctrl+Tab:
+  // HIDDEN menu:
     miMenuHidden: TMenuItem;
     minexttab: TMenuItem;
+    selectall1: TMenuItem;
 
-  // Панель инструментов:
+  // Toolbar:
+    ilToolbar: TImageList;
     MainToolBar: TToolBar;
-    pbLoad: TProgressBar;
-    pLoadProgress: TPanel;
-    RenderPanel: TOpenGLControl;
-    Separator1: TMenuItem;
-    miMacRecentEnd: TMenuItem;
-    miWinRecentStart: TMenuItem;
-    Separator2: TMenuItem;
     tbNewMap: TToolButton;
     tbOpenMap: TToolButton;
     tbSaveMap: TToolButton;
@@ -108,12 +115,6 @@ type
     tbShowMap: TToolButton;
     tbLine2: TToolButton;
     tbShow: TToolButton;
-    tbLine3: TToolButton;
-    tbGridOn: TToolButton;
-    tbGrid: TToolButton;
-    tbLine4: TToolButton;
-    tbTestMap: TToolButton;
-  // Всплывающее меню для кнопки слоев:
     pmShow: TPopupMenu;
     miLayerP1: TMenuItem;
     miLayerP2: TMenuItem;
@@ -124,29 +125,37 @@ type
     miLayerP7: TMenuItem;
     miLayerP8: TMenuItem;
     miLayerP9: TMenuItem;
+    tbLine3: TToolButton;
+    tbGridOn: TToolButton;
+    tbGrid: TToolButton;
+    tbLine4: TToolButton;
+    tbTestMap: TToolButton;
 
-  // Панель карты:
+  // Progress bar:
+    pLoadProgress: TPanel;
+    lLoad: TLabel;
+    pbLoad: TProgressBar;
+
+  // Map edit area:
     PanelMap: TPanel;
-  // Полосы прокрутки:
+    RenderPanel: TOpenGLControl;
     sbHorizontal: TScrollBar;
     sbVertical: TScrollBar;
 
-  // Панель свойств:
+  // Object propertiy editor:
     PanelProps: TPanel;
-  // Панель применения свойств:
     PanelPropApply: TPanel;
     bApplyProperty: TButton;
-    MapTestTimer: TTimer;
-  // Редактор свойств объектов:
     vleObjectProperty: TValueListEditor;
 
-  // Панель объектов - вкладки:
+  // Object palette:
     PanelObjs: TPanel;
     pcObjects: TPageControl;
-  // Вкладка "Панели":
+  // Panels Tab:
     tsPanels: TTabSheet;
+    PanelPanelType: TPanel;
+    lbPanelType: TListBox;
     lbTextureList: TListBox;
-  // Панель настройки текстур:
     PanelTextures: TPanel;
     LabelTxW: TLabel;
     lTextureWidth: TLabel;
@@ -156,43 +165,27 @@ type
     bbAddTexture: TBitBtn;
     bbRemoveTexture: TBitBtn;
     bClearTexture: TButton;
-  // Панель типов панелей:
-    PanelPanelType: TPanel;
-    lbPanelType: TListBox;
-  // Вкладка "Предметы":
+  // Items Tab:
     tsItems: TTabSheet;
     lbItemList: TListBox;
     cbOnlyDM: TCheckBox;
     cbFall: TCheckBox;
-  // Вкладка "Монстры":
+  // Monsters Tab:
     tsMonsters: TTabSheet;
     lbMonsterList: TListBox;
     rbMonsterLeft: TRadioButton;
     rbMonsterRight: TRadioButton;
-  // Вкладка "Области":
+  // Areas Tab:
     tsAreas: TTabSheet;
     lbAreasList: TListBox;
     rbAreaLeft: TRadioButton;
     rbAreaRight: TRadioButton;
-  // Вкладка "Триггеры":
+  // Triggers Tab:
     tsTriggers: TTabSheet;
     lbTriggersList: TListBox;
     clbActivationType: TCheckListBox;
     clbKeys: TCheckListBox;
 
-  // Остальные панели
-    Splitter1: TSplitter;
-    Splitter2: TSplitter;
-    StatusBar: TStatusBar;
-
-  // Специальные объекты:
-    ImageList: TImageList;
-    ilToolbar: TImageList;
-    OpenDialog: TOpenDialog;
-    SaveDialog: TSaveDialog;
-    selectall1: TMenuItem;
-    ColorDialog: TColorDialog;
-
     procedure aAboutExecute(Sender: TObject);
     procedure aCheckMapExecute(Sender: TObject);
     procedure aMoveToFore(Sender: TObject);
@@ -222,6 +215,7 @@ type
     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormResize(Sender: TObject);
     procedure FormWindowStateChange(Sender: TObject);
+    procedure miRecentFileExecute(Sender: TObject);
     procedure miMacRecentClearClick(Sender: TObject);
     procedure miMacZoomClick(Sender: TObject);
     procedure lbTextureListClick(Sender: TObject);
@@ -414,8 +408,7 @@ const
 
 type
   TUndoRec = record
-    UndoType: Byte;
-    case Byte of
+    case UndoType: Byte of
       UNDO_DELETE_PANEL:   (Panel: ^TPanel);
       UNDO_DELETE_ITEM:    (Item: TItem);
       UNDO_DELETE_AREA:    (Area: TArea);
@@ -436,9 +429,8 @@ type
   end;
 
   TCopyRec = record
-    ObjectType: Byte;
     ID: Cardinal;
-    case Byte of
+    case ObjectType: Byte of
       OBJECT_PANEL: (Panel: ^TPanel);
       OBJECT_ITEM: (Item: TItem);
       OBJECT_AREA: (Area: TArea);
@@ -2566,29 +2558,14 @@ end;
 //Закончились вспомогательные процедуры
 //----------------------------------------
 
-type
-  TRecentHandler = class
-    private
-      FForm: TMainForm;
-      FPath: String;
-    public
-      constructor Create (form: TMainForm; path: String);
-      procedure Execute (Sender: TObject);
-  end;
-
-constructor TRecentHandler.Create (form: TMainForm; path: String);
-begin
-  Assert(form <> nil);
-  FForm := form;
-  FPath := path;
-end;
-
-procedure TRecentHandler.Execute (Sender: TObject);
-  var fn: AnsiString;
+procedure TMainForm.miRecentFileExecute (Sender: TObject);
+var
+  s, fn: AnsiString;
 begin
-  fn := g_ExtractWadName(FPath);
+  s := RecentFiles[(Sender as TMenuItem).Tag];
+  fn := g_ExtractWadName(s);
   if FileExists(fn) then
-    OpenMap(fn, g_ExtractFilePathName(FPath))
+    OpenMap(fn, g_ExtractFilePathName(s))
   else
     Application.MessageBox('', 'File not available anymore', MB_OK);
 //  if Application.MessageBox(PChar(MsgMsgDelRecentPromt), PChar(MsgMsgDelRecent), MB_ICONQUESTION or MB_YESNO) = idYes then
@@ -2599,40 +2576,35 @@ begin
 end;
 
 procedure TMainForm.RefillRecentMenu (menu: TMenuItem; start: Integer; fmt: AnsiString);
-  var i: Integer; MI: TMenuItem; cb: TMethod; h: TRecentHandler; s: AnsiString;
+  var i: Integer; MI: TMenuItem; s: AnsiString;
 begin
   Assert(menu <> nil);
   Assert(start >= 0);
   Assert(start <= menu.Count);
 
-  // clear all recent entries from menu
+  // clear all the recent entries from menu
   i := start;
   while i < menu.Count do
   begin
     MI := menu.Items[i];
-    cb := TMethod(MI.OnClick);
-    if cb.Code = @TRecentHandler.Execute then
+    if @MI.OnClick <> @TMainForm.miRecentFileExecute then
+      i += 1
+    else
     begin
-      // this is recent menu entry
-      // remove it and free callback handler
-      h := TRecentHandler(cb.Data);
       menu.Delete(i);
-      MI.Free();
-      h.Free();
-    end
-    else
-      Inc(i);
+      MI.Destroy();
+    end;
   end;
 
   // fill with a new ones
-  for i := 0 to RecentFiles.Count - 1 do
+  for i := 0 to RecentFiles.Count-1 do
   begin
-    s := RecentFiles[i];
-    h := TRecentHandler.Create(self, s);
     MI := TMenuItem.Create(menu);
-    MI.Caption := Format(fmt, [i + 1, g_ExtractWadNameNoPath(s), g_ExtractFilePathName(s)]);
-    MI.OnClick := h.Execute;
-    menu.Insert(start + i, MI);
+    s := RecentFiles[i];
+    MI.Caption := Format(fmt, [i+1, g_ExtractWadNameNoPath(s), g_ExtractFilePathName(s)]);
+    MI.OnClick := miRecentFileExecute;
+    MI.Tag := i;
+    menu.Insert(start + i, MI);  // transfers ownership
   end;
 end;
 
@@ -2654,7 +2626,7 @@ begin
   begin
     // Reconstruct Windows-like recent list
     start := miMenuFile.IndexOf(miWinRecent);
-    if start < 0 then start := miMenuFile.Count else start := start + 1;
+    if start < 0 then start := miMenuFile.Count else start += 1;
     RefillRecentMenu(miMenuFile, start, '%0:d %1:s:%2:s');
     miWinRecent.Enabled := False;
     miWinRecent.Visible := RecentFiles.Count = 0;
@@ -2842,14 +2814,8 @@ begin
     gAlphaTriggerArea := ALPHA_AREA;
   gAlphaMonsterRect := config.ReadInt('Editor', 'MonsterRectAlpha', 0);
   gAlphaAreaRect := config.ReadInt('Editor', 'AreaRectAlpha', 0);
-  if config.ReadInt('Editor', 'Scale', 0) = 1 then
-    Scale := 2
-  else
-    Scale := 1;
-  if config.ReadInt('Editor', 'DotSize', 0) = 1 then
-    DotSize := 2
-  else
-    DotSize := 1;
+  Scale := Max(config.ReadInt('Editor', 'Scale', 1), 1);
+  DotSize := Max(config.ReadInt('Editor', 'DotSize', 1), 1);
   OpenDialog.InitialDir := config.ReadStr('Editor', 'LastOpenDir', MapsDir);
   SaveDialog.InitialDir := config.ReadStr('Editor', 'LastSaveDir', MapsDir);
 
@@ -4380,6 +4346,8 @@ begin
 // Строка состояния - координаты мыши:
   StatusBar.Panels[1].Text := Format('(%d:%d)',
     [MousePos.X-MapOffset.X, MousePos.Y-MapOffset.Y]);
+
+  RenderPanel.Invalidate;
 end;
 
 procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
@@ -4552,7 +4520,7 @@ begin
       end
     end;
 
-    if Key = Ord('V') then
+    if Key = Ord('I') then
     begin // Поворот монстров и областей:
       if (SelectedObjects <> nil) then
       begin
@@ -5726,7 +5694,7 @@ begin
     QuickSortCopyBuffer(0, b);
   end;
 
-// Ð\9fестановка ссылок триггеров:
+// Ð\9fостановка ссылок триггеров:
   for a := 0 to Length(CopyBuffer)-1 do
     if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then
     begin
@@ -5831,21 +5799,33 @@ var
   swad, ssec, sres: String;
   NoTextureID: DWORD;
   pmin: TPoint;
+  xadj, yadj: LongInt;
 begin
   CopyBuffer := nil;
   NoTextureID := 0;
+
   pmin.X := High(pmin.X);
   pmin.Y := High(pmin.Y);
 
   StringToCopyBuffer(ClipBoard.AsText, CopyBuffer, pmin);
-  rel := not(ssShift in GetKeyShiftState());
-
   if CopyBuffer = nil then
     Exit;
 
+  rel := not(ssShift in GetKeyShiftState());
+  h := High(CopyBuffer);
   RemoveSelectFromObjects();
 
-  h := High(CopyBuffer);
+  if h > 0 then
+  begin
+    xadj := Floor((-pmin.X - MapOffset.X + 32) / DotStep) * DotStep;
+    yadj := Floor((-pmin.Y - MapOffset.Y + 32) / DotStep) * DotStep;
+  end
+  else
+  begin
+    xadj := DotStep;
+    yadj := DotStep;
+  end;
+
   for a := 0 to h do
     with CopyBuffer[a] do
     begin
@@ -5855,8 +5835,8 @@ begin
           begin
             if rel then
             begin
-              Panel^.X := Panel^.X - pmin.X - MapOffset.X + 32;
-              Panel^.Y := Panel^.Y - pmin.Y - MapOffset.Y + 32;
+              Panel^.X += xadj;
+              Panel^.Y += yadj;
             end;
 
             Panel^.TextureID := TEXTURE_SPECIAL_NONE;
@@ -5914,8 +5894,8 @@ begin
           begin
             if rel then
             begin
-              Item.X := Item.X - pmin.X - MapOffset.X + 32;
-              Item.Y := Item.Y - pmin.Y - MapOffset.Y + 32;
+              Item.X += xadj;
+              Item.Y += yadj;
             end;
 
             ID := AddItem(Item);
@@ -5927,8 +5907,8 @@ begin
           begin
             if rel then
             begin
-              Monster.X := Monster.X - pmin.X - MapOffset.X + 32;
-              Monster.Y := Monster.Y - pmin.Y - MapOffset.Y + 32;
+              Monster.X += xadj;
+              Monster.Y += yadj;
             end;
 
             ID := AddMonster(Monster);
@@ -5940,8 +5920,8 @@ begin
           begin
             if rel then
             begin
-              Area.X := Area.X - pmin.X - MapOffset.X + 32;
-              Area.Y := Area.Y - pmin.Y - MapOffset.Y + 32;
+              Area.X += xadj;
+              Area.Y += yadj;
             end;
 
             ID := AddArea(Area);
@@ -5954,42 +5934,34 @@ begin
             if rel then
               with Trigger do
               begin
-                X := X - pmin.X - MapOffset.X + 32;
-                Y := Y - pmin.Y - MapOffset.Y + 32;
+                X += xadj;
+                Y += yadj;
 
                 case TriggerType of
                   TRIGGER_TELEPORT:
                     begin
-                      Data.TargetPoint.X :=
-                      Data.TargetPoint.X - pmin.X - MapOffset.X + 32;
-                      Data.TargetPoint.Y :=
-                      Data.TargetPoint.Y - pmin.Y - MapOffset.Y + 32;
+                      Data.TargetPoint.X += xadj;
+                      Data.TargetPoint.Y += yadj;
                     end;
                   TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
                     begin
-                      Data.tX := Data.tX - pmin.X - MapOffset.X + 32;
-                      Data.tY := Data.tY - pmin.Y - MapOffset.Y + 32;
+                      Data.tX += xadj;
+                      Data.tY += yadj;
                     end;
                   TRIGGER_SPAWNMONSTER:
                     begin
-                      Data.MonPos.X :=
-                      Data.MonPos.X - pmin.X - MapOffset.X + 32;
-                      Data.MonPos.Y :=
-                      Data.MonPos.Y - pmin.Y - MapOffset.Y + 32;
+                      Data.MonPos.X += xadj;
+                      Data.MonPos.Y += yadj;
                     end;
                   TRIGGER_SPAWNITEM:
                     begin
-                      Data.ItemPos.X :=
-                      Data.ItemPos.X - pmin.X - MapOffset.X + 32;
-                      Data.ItemPos.Y :=
-                      Data.ItemPos.Y - pmin.Y - MapOffset.Y + 32;
+                      Data.ItemPos.X += xadj;
+                      Data.ItemPos.Y += yadj;
                     end;
                   TRIGGER_SHOT:
                     begin
-                      Data.ShotPos.X :=
-                      Data.ShotPos.X - pmin.X - MapOffset.X + 32;
-                      Data.ShotPos.Y :=
-                      Data.ShotPos.Y - pmin.Y - MapOffset.Y + 32;
+                      Data.ShotPos.X += xadj;
+                      Data.ShotPos.Y += yadj;
                     end;
                 end;
               end;
@@ -7000,12 +6972,14 @@ procedure TMainForm.sbVerticalScroll(Sender: TObject;
   ScrollCode: TScrollCode; var ScrollPos: Integer);
 begin
   MapOffset.Y := -sbVertical.Position;
+  RenderPanel.Invalidate;
 end;
 
 procedure TMainForm.sbHorizontalScroll(Sender: TObject;
   ScrollCode: TScrollCode; var ScrollPos: Integer);
 begin
   MapOffset.X := -sbHorizontal.Position;
+  RenderPanel.Invalidate;
 end;
 
 procedure TMainForm.miOpenWadMapClick(Sender: TObject);