X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_main.pas;h=790a646a334b9ff69700d3237260483e6baf427b;hb=6440b720d7e55069ae59d8c4340981b594c4499b;hp=e2635344a0977677c10d8bf4e71ec0a2470fcfb9;hpb=3ea052bd6b0f429986d2ebae74d04a01875ac9fc;p=d2df-editor.git diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index e263534..790a646 100644 --- a/src/editor/f_main.pas +++ b/src/editor/f_main.pas @@ -8,7 +8,7 @@ uses LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ComCtrls, ValEdit, Types, Menus, ExtCtrls, - CheckLst, Grids, OpenGLContext, utils, UTF8Process; + CheckLst, Grids, OpenGLContext, Utils, UTF8Process; type @@ -18,18 +18,27 @@ type lLoad: TLabel; // Главное меню: MainMenu: TMainMenu; + // Apple menu: + miApple: TMenuItem; + miAppleAbout: TMenuItem; + miAppleLine0: TMenuItem; + miApplePref: TMenuItem; + miAppleLine1: TMenuItem; // "Файл": miMenuFile: TMenuItem; miNewMap: TMenuItem; miOpenMap: TMenuItem; miSaveMap: TMenuItem; miSaveMapAs: TMenuItem; + miMacRecentSubMenu: TMenuItem; + miMacRecentClear: TMenuItem; miOpenWadMap: TMenuItem; miLine1: TMenuItem; miReopenMap: TMenuItem; miSaveMiniMap: TMenuItem; miDeleteMap: TMenuItem; miPackMap: TMenuItem; + miWinRecent: TMenuItem; miLine2: TMenuItem; miExit: TMenuItem; // "Правка": @@ -44,11 +53,8 @@ type miLine5: TMenuItem; miToFore: TMenuItem; miToBack: TMenuItem; - // "Инструменты": - miMenuTools: TMenuItem; - miSnapToGrid: TMenuItem; - miMiniMap: TMenuItem; - miSwitchGrid: TMenuItem; + // View menu: + miMenuView: TMenuItem; miShowEdges: TMenuItem; miLayers: TMenuItem; miLayer1: TMenuItem; @@ -60,24 +66,29 @@ type miLayer7: TMenuItem; miLayer8: TMenuItem; miLayer9: TMenuItem; + miViewLine1: TMenuItem; + miMiniMap: TMenuItem; + miViewLine2: TMenuItem; + miMapPreview: TMenuItem; + miSnapToGrid: TMenuItem; + miSwitchGrid: TMenuItem; + miLine6: TMenuItem; + miOptions: TMenuItem; + miMapOptions: TMenuItem; // "Сервис": miMenuService: TMenuItem; miCheckMap: TMenuItem; miOptimmization: TMenuItem; - miMapPreview: TMenuItem; miTestMap: TMenuItem; - // "Настройка": - miMenuSettings: TMenuItem; - miMapOptions: TMenuItem; - miLine6: TMenuItem; - miOptions: TMenuItem; - miLine7: TMenuItem; - miMapTestSettings: TMenuItem; + // Window menu: + miMenuWindow: TMenuItem; + miMacMinimize: TMenuItem; + miMacZoom: TMenuItem; // "Справка": miMenuHelp: TMenuItem; miAbout: TMenuItem; // Скрытый пункт меню для Ctrl+Tab: - miHidden1: TMenuItem; + miMenuHidden: TMenuItem; minexttab: TMenuItem; // Панель инструментов: @@ -85,6 +96,10 @@ type pbLoad: TProgressBar; pLoadProgress: TPanel; RenderPanel: TOpenGLControl; + Separator1: TMenuItem; + miMacRecentEnd: TMenuItem; + miWinRecentStart: TMenuItem; + Separator2: TMenuItem; tbNewMap: TToolButton; tbOpenMap: TToolButton; tbSaveMap: TToolButton; @@ -109,9 +124,6 @@ type miLayerP7: TMenuItem; miLayerP8: TMenuItem; miLayerP9: TMenuItem; - // Всплывающее меню для кнопки теста карты: - pmMapTest: TPopupMenu; - miMapTestPMSet: TMenuItem; // Панель карты: PanelMap: TPanel; @@ -124,6 +136,7 @@ type // Панель применения свойств: PanelPropApply: TPanel; bApplyProperty: TButton; + MapTestTimer: TTimer; // Редактор свойств объектов: vleObjectProperty: TValueListEditor; @@ -208,9 +221,13 @@ type procedure FormDropFiles(Sender: TObject; const FileNames: array of String); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormResize(Sender: TObject); + procedure FormWindowStateChange(Sender: TObject); + procedure miMacRecentClearClick(Sender: TObject); + procedure miMacZoomClick(Sender: TObject); procedure lbTextureListClick(Sender: TObject); procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState); + procedure miMacMinimizeClick(Sender: TObject); procedure miReopenMapClick(Sender: TObject); procedure RenderPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure RenderPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); @@ -218,6 +235,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); @@ -243,8 +261,6 @@ type procedure miSaveMiniMapClick(Sender: TObject); 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); @@ -263,6 +279,7 @@ type private procedure Draw(); procedure OnIdle(Sender: TObject; var Done: Boolean); + procedure RefillRecentMenu (menu: TMenuItem; start: Integer; fmt: AnsiString); public procedure RefreshRecentMenu(); procedure OpenMapFile(FileName: String); @@ -286,14 +303,14 @@ const var MainForm: TMainForm; - EditorDir: String; + StartMap: String; OpenedMap: String; OpenedWAD: String; DotColor: TColor; DotEnable: Boolean; - DotStep: Byte; - DotStepOne, DotStepTwo: Byte; + DotStep: Word; + DotStepOne, DotStepTwo: Word; DotSize: Byte; DrawTexturePanel: Boolean; DrawPanelSize: Boolean; @@ -313,11 +330,13 @@ var TestOptionsAllowExit: Boolean; TestOptionsWeaponStay: Boolean; TestOptionsMonstersDM: Boolean; - TestD2dExe: String; + TestD2dExe, TestD2DArgs: String; TestMapOnce: Boolean; LayerEnabled: Array [LAYER_BACK..LAYER_TRIGGERS] of Boolean = (True, True, True, True, True, True, True, True, True); + ContourEnabled: Array [LAYER_BACK..LAYER_TRIGGERS] of Boolean = + (False, False, False, False, False, False, False, False, False); PreviewMode: Byte = 0; gLanguage: String; @@ -335,11 +354,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, - MAPREADER, f_selectmap, f_savemap, WADEDITOR, WADSTRUCT, MAPDEF, + 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; + f_addresource_sound, f_choosetype, + g_language, f_selectlang, ClipBrd, g_resources, g_options; const UNDO_DELETE_PANEL = 1; @@ -440,9 +459,10 @@ var LastMovePoint: Types.TPoint; MouseLDown: Boolean; MouseRDown: Boolean; + MouseMDown: Boolean; MouseLDownPos: Types.TPoint; MouseRDownPos: Types.TPoint; - WASDOffset: TPoint; + MouseMDownPos: Types.TPoint; SelectFlag: Byte = SELECTFLAG_NONE; MouseAction: Byte = MOUSEACTION_NONE; @@ -454,6 +474,8 @@ var UndoBuffer: Array of Array of TUndoRec = nil; + MapTestProcess: TProcessUTF8; + MapTestFile: String; {$R *.lfm} @@ -693,10 +715,10 @@ begin begin ScaleSz := 16 div Scale; // Размер видимой части карты: - rx := min(Normalize16(Width), Normalize16(gMapInfo.Width)) div 2; - ry := min(Normalize16(Height), Normalize16(gMapInfo.Height)) div 2; + rx := Min(Normalize16(Width), Normalize16(gMapInfo.Width)) div 2; + ry := Min(Normalize16(Height), Normalize16(gMapInfo.Height)) div 2; // Место клика на мини-карте: - MapOffset.X := X - (Width-max(gMapInfo.Width div ScaleSz, 1)-1); + MapOffset.X := X - (Width - Max(gMapInfo.Width div ScaleSz, 1) - 1); MapOffset.Y := Y - 1; // Это же место на "большой" карте: MapOffset.X := MapOffset.X * ScaleSz; @@ -705,17 +727,11 @@ begin MapOffset.X := MapOffset.X - rx; MapOffset.Y := MapOffset.Y - ry; // Выход за границы: - if MapOffset.X < 0 then - MapOffset.X := 0; - if MapOffset.Y < 0 then - MapOffset.Y := 0; - 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); + // MapOffset.X := Normalize16(MapOffset.X); + // MapOffset.Y := Normalize16(MapOffset.Y); end; MainForm.sbHorizontal.Position := MapOffset.X; @@ -1409,6 +1425,20 @@ begin EditStyle := esSimple; MaxLength := 5; end; + case Data.DamageKind of + 3: str := _lc[I_PROP_TR_DAMAGE_KIND_3]; + 4: str := _lc[I_PROP_TR_DAMAGE_KIND_4]; + 5: str := _lc[I_PROP_TR_DAMAGE_KIND_5]; + 6: str := _lc[I_PROP_TR_DAMAGE_KIND_6]; + 7: str := _lc[I_PROP_TR_DAMAGE_KIND_7]; + 8: str := _lc[I_PROP_TR_DAMAGE_KIND_8]; + else str := _lc[I_PROP_TR_DAMAGE_KIND_0]; + end; + with ItemProps[InsertRow(_lc[I_PROP_TR_DAMAGE_KIND], str, True)] do + begin + EditStyle := esPickList; + ReadOnly := True; + end; end; TRIGGER_HEALTH: @@ -1828,7 +1858,7 @@ end; 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; @@ -1919,7 +1949,6 @@ begin 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 @@ -1931,7 +1960,7 @@ begin end else begin // Внешний WAD - FileName := EditorDir+'wads/'+aWAD; + FileName := WadsDir + DirectorySeparator + aWAD; ResourceName := aWAD+':'+SectionName+'\'+aTex; end; @@ -2230,6 +2259,7 @@ procedure SwitchMap(); begin ShowMap := not ShowMap; MainForm.tbShowMap.Down := ShowMap; + MainForm.miMiniMap.Checked := ShowMap; end; procedure ShowEdges(); @@ -2238,6 +2268,7 @@ begin drEdge[3] := 255 else drEdge[3] := gAlphaEdge; + MainForm.miShowEdges.Checked := drEdge[3] <> 255; end; function SelectedTexture(): String; @@ -2535,80 +2566,107 @@ end; //Закончились вспомогательные процедуры //---------------------------------------- -procedure TMainForm.RefreshRecentMenu(); -var - i: Integer; - MI: TMenuItem; +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 -// Лишние запомненные карты: - while RecentFiles.Count > RecentCount do - RecentFiles.Delete(RecentFiles.Count-1); + Assert(form <> nil); + FForm := form; + FPath := path; +end; + +procedure TRecentHandler.Execute (Sender: TObject); + var fn: AnsiString; +begin + fn := g_ExtractWadName(FPath); + if FileExists(fn) then + OpenMap(fn, g_ExtractFilePathName(FPath)) + else + Application.MessageBox('', 'File not available anymore', MB_OK); +// if Application.MessageBox(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; -// Лишние строки меню: - while MainMenu.Items[0].Count > RECENT_FILES_MENU_START do - MainMenu.Items[0].Delete(MainMenu.Items[0].Count-1); +procedure TMainForm.RefillRecentMenu (menu: TMenuItem; start: Integer; fmt: AnsiString); + var i: Integer; MI: TMenuItem; cb: TMethod; h: TRecentHandler; s: AnsiString; +begin + Assert(menu <> nil); + Assert(start >= 0); + Assert(start <= menu.Count); -// Отделение списка карт от строки "Выход": - if RecentFiles.Count > 0 then + // clear all recent entries from menu + i := start; + while i < menu.Count do begin - MI := TMenuItem.Create(MainMenu.Items[0]); - MI.Caption := '-'; - MainMenu.Items[0].Add(MI); + MI := menu.Items[i]; + cb := TMethod(MI.OnClick); + if cb.Code = @TRecentHandler.Execute then + 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); end; -// Добавление в меню списка запомненных карт: - for i := 0 to RecentFiles.Count-1 do + // fill with a new ones + for i := 0 to RecentFiles.Count - 1 do begin - MI := TMenuItem.Create(MainMenu.Items[0]); - MI.Caption := IntToStr(i+1) + ' ' + RecentFiles[i]; - MI.OnClick := aRecentFileExecute; - MainMenu.Items[0].Add(MI); + 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); end; end; -procedure TMainForm.aRecentFileExecute(Sender: TObject); -var - n, pw: Integer; - s, fn: String; - b: Boolean; +procedure TMainForm.RefreshRecentMenu(); + var start: Integer; 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; + while RecentFiles.Count > RecentCount do + RecentFiles.Delete(RecentFiles.Count - 1); - 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 miMacRecentSubMenu.Visible then + begin + // Reconstruct OSX-like recent list + RefillRecentMenu(miMacRecentSubMenu, 0, '%1:s - %2:s'); + miMacRecentEnd.Enabled := RecentFiles.Count <> 0; + miMacRecentEnd.Visible := RecentFiles.Count <> 0; + 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 + if miWinRecentStart.Visible then begin - RecentFiles.Delete(n); - RefreshRecentMenu(); + // Reconstruct Windows-like recent list + start := miMenuFile.IndexOf(miWinRecent); + if start < 0 then start := miMenuFile.Count else start := start + 1; + RefillRecentMenu(miMenuFile, start, '%0:d %1:s:%2:s'); + miWinRecent.Enabled := False; + miWinRecent.Visible := RecentFiles.Count = 0; end; end; +procedure TMainForm.miMacRecentClearClick(Sender: TObject); +begin + RecentFiles.Clear(); + RefreshRecentMenu(); +end; + procedure TMainForm.aEditorOptionsExecute(Sender: TObject); begin OptionsForm.ShowModal(); @@ -2619,23 +2677,15 @@ var cwdt, chgt: Byte; spc: ShortInt; ID: DWORD; - wad: TWADEditor_1; cfgdata: Pointer; cfglen: Integer; config: TConfig; begin - cfgdata := nil; - cfglen := 0; ID := 0; - - wad := TWADEditor_1.Create; - if wad.ReadFile(EditorDir+'data/Game.wad') then - wad.GetResource('FONTS', cfgres, cfgdata, cfglen); - wad.Free(); - - if cfglen <> 0 then + 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); @@ -2644,14 +2694,15 @@ begin spc := Min(Max(config.ReadInt('FontMap', 'Kerning', 0), -128), 127); if g_GetTexture('FONT_STD', ID) then - e_TextureFontBuild(ID, FontID, cwdt, chgt, spc-2); + e_TextureFontBuild(ID, FontID, cwdt, chgt, spc - 2); config.Free(); + FreeMem(cfgdata) end else - e_WriteLog('Could not load FONT_STD', MSG_WARNING); - - if cfglen <> 0 then FreeMem(cfgdata); + begin + e_WriteLog('Could not load FONT_STD', MSG_WARNING) + end end; procedure TMainForm.FormCreate(Sender: TObject); @@ -2662,9 +2713,69 @@ var begin Randomize(); - EditorDir := ExtractFilePath(Application.ExeName); - - e_InitLog(EditorDir+'Editor.log', WM_NEWFILE); + {$IFDEF DARWIN} + miApple.Enabled := True; + miApple.Visible := True; + miMacRecentSubMenu.Enabled := True; + miMacRecentSubMenu.Visible := True; + miWinRecentStart.Enabled := False; + miWinRecentStart.Visible := False; + miWinRecent.Enabled := False; + miWinRecent.Visible := False; + miLine2.Enabled := False; + miLine2.Visible := False; + miExit.Enabled := False; + miExit.Visible := False; + miOptions.Enabled := False; + miOptions.Visible := False; + miMenuWindow.Enabled := True; + miMenuWindow.Visible := True; + miAbout.Enabled := False; + miAbout.Visible := False; + {$ELSE} + miApple.Enabled := False; + miApple.Visible := False; + miMacRecentSubMenu.Enabled := False; + miMacRecentSubMenu.Visible := False; + miWinRecentStart.Enabled := True; + miWinRecentStart.Visible := True; + miWinRecent.Enabled := True; + miWinRecent.Visible := True; + miLine2.Enabled := True; + miLine2.Visible := True; + miExit.Enabled := True; + miExit.Visible := True; + miOptions.Enabled := True; + miOptions.Visible := True; + miMenuWindow.Enabled := False; + miMenuWindow.Visible := False; + miAbout.Enabled := True; + miAbout.Visible := True; + {$ENDIF} + + miNewMap.ShortCut := ShortCut(VK_N, [ssModifier]); + miOpenMap.ShortCut := ShortCut(VK_O, [ssModifier]); + miSaveMap.ShortCut := ShortCut(VK_S, [ssModifier]); + {$IFDEF DARWIN} + miSaveMapAs.ShortCut := ShortCut(VK_S, [ssModifier, ssShift]); + miReopenMap.ShortCut := ShortCut(VK_F5, [ssModifier]); + {$ENDIF} + miUndo.ShortCut := ShortCut(VK_Z, [ssModifier]); + miCopy.ShortCut := ShortCut(VK_C, [ssModifier]); + miCut.ShortCut := ShortCut(VK_X, [ssModifier]); + miPaste.ShortCut := ShortCut(VK_V, [ssModifier]); + miSelectAll.ShortCut := ShortCut(VK_A, [ssModifier]); + miToFore.ShortCut := ShortCut(VK_LCL_CLOSE_BRACKET, [ssModifier]); + miToBack.ShortCut := ShortCut(VK_LCL_OPEN_BRACKET, [ssModifier]); + {$IFDEF DARWIN} + miMapOptions.Shortcut := ShortCut(VK_P, [ssModifier, ssAlt]); + selectall1.Shortcut := ShortCut(VK_A, [ssModifier, ssAlt]); + {$ENDIF} + + 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; @@ -2684,7 +2795,7 @@ begin OpenedMap := ''; OpenedWAD := ''; - config := TConfig.CreateFile(EditorDir+'Editor.cfg'); + config := TConfig.CreateFile(CfgFileName); if config.ReadInt('Editor', 'XPos', -1) = -1 then Position := poDesktopCenter @@ -2739,12 +2850,33 @@ begin 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; @@ -2754,7 +2886,11 @@ begin RecentFiles := TStringList.Create(); for i := 0 to RecentCount-1 do begin - s := config.ReadStr('RecentFiles', IntToStr(i+1), ''); + {$IFDEF WINDOWS} + s := config.ReadStr('RecentFilesWin', IntToStr(i), ''); + {$ELSE} + s := config.ReadStr('RecentFilesUnix', IntToStr(i), ''); + {$ENDIF} if s <> '' then RecentFiles.Add(s); end; @@ -2842,12 +2978,22 @@ begin else a := 0; - for x := 0 to (RenderPanel.Width div DotStep) do - for y := 0 to (RenderPanel.Height div DotStep) do - e_DrawPoint(DotSize, x*DotStep + a, y*DotStep + a, + x := MapOffset.X mod DotStep; + y := MapOffset.Y mod DotStep; + + while x < RenderPanel.Width do + begin + while y < RenderPanel.Height do + begin + e_DrawPoint(DotSize, x + a, y + a, GetRValue(DotColor), GetGValue(DotColor), GetBValue(DotColor)); + y += DotStep; + end; + x += DotStep; + y := MapOffset.Y mod DotStep; + end; end; // Превью текстуры: @@ -3098,18 +3244,31 @@ procedure TMainForm.FormResize(Sender: TObject); begin e_SetViewPort(0, 0, RenderPanel.Width, RenderPanel.Height); - if gMapInfo.Width >= RenderPanel.Width then - sbHorizontal.Max := Normalize16(gMapInfo.Width-RenderPanel.Width+16) - else - sbHorizontal.Max := 0; + sbHorizontal.Min := Min(gMapInfo.Width - RenderPanel.Width, -RenderPanel.Width div 2); + sbHorizontal.Max := Max(0, gMapInfo.Width - RenderPanel.Width div 2); + sbVertical.Min := Min(gMapInfo.Height - RenderPanel.Height, -RenderPanel.Height div 2); + sbVertical.Max := Max(0, gMapInfo.Height - RenderPanel.Height div 2); - if gMapInfo.Height >= RenderPanel.Height then - sbVertical.Max := Normalize16(gMapInfo.Height-RenderPanel.Height+16) - else - sbVertical.Max := 0; + MapOffset.X := -sbHorizontal.Position; + MapOffset.Y := -sbVertical.Position; +end; - MapOffset.X := -Normalize16(sbHorizontal.Position); - MapOffset.Y := -Normalize16(sbVertical.Position); +procedure TMainForm.FormWindowStateChange(Sender: TObject); + {$IFDEF DARWIN} + var e: Boolean; + {$ENDIF} +begin + {$IFDEF DARWIN} + // deactivate all menus when main window minimized + e := self.WindowState <> wsMinimized; + miMenuFile.Enabled := e; + miMenuEdit.Enabled := e; + miMenuView.Enabled := e; + miMenuService.Enabled := e; + miMenuWindow.Enabled := e; + miMenuHelp.Enabled := e; + miMenuHidden.Enabled := e; + {$ENDIF} end; procedure SelectNextObject(X, Y: Integer; ObjectType: Byte; ID: DWORD); @@ -3600,6 +3759,16 @@ begin 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; @@ -3637,6 +3806,8 @@ begin MouseLDown := False; if Button = mbRight then MouseRDown := False; + if Button = mbMiddle then + MouseMDown := False; DrawRect := nil; ResizeType := RESIZETYPE_NONE; @@ -3946,7 +4117,7 @@ begin 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 @@ -3957,6 +4128,7 @@ begin // Объект передвинут или изменен в размере: if MouseAction in [MOUSEACTION_MOVEOBJ, MOUSEACTION_RESIZE] then begin + RenderPanel.Cursor := crDefault; MouseAction := MOUSEACTION_NONE; FillProperty(); Exit; @@ -4009,6 +4181,12 @@ begin SelectObjects(pcObjects.ActivePageIndex+1); FillProperty(); + end + + else // Middle Mouse Button + begin + RenderPanel.Cursor := crDefault; + ReleaseCapture(); end; end; @@ -4089,16 +4267,12 @@ begin end else begin // Кнопки мыши не зажаты - MousePos.X := (Round(X/sX)*sX); - MousePos.Y := (Round(Y/sY)*sY); + MousePos.X := Round((-MapOffset.X + X) / sX) * sX + MapOffset.X; + 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 @@ -4115,10 +4289,8 @@ begin if MouseAction = MOUSEACTION_MOVEOBJ then begin MoveSelectedObjects(ssShift in Shift, ssCtrl in Shift, - MousePos.X-LastMovePoint.X+WASDOffset.X, - MousePos.Y-LastMovePoint.Y+WASDOffset.Y); - WASDOffset.X := 0; - WASDOffset.Y := 0; + MousePos.X-LastMovePoint.X, + MousePos.Y-LastMovePoint.Y); end else // Меняем размер выделенного объекта: @@ -4127,10 +4299,8 @@ begin if (SelectedObjectCount = 1) and (SelectedObjects[GetFirstSelected].Live) then begin - dWidth := MousePos.X-LastMovePoint.X+WASDOffset.X; - dHeight := MousePos.Y-LastMovePoint.Y+WASDOffset.Y; - WASDOffset.X := 0; - WASDOffset.Y := 0; + dWidth := MousePos.X-LastMovePoint.X; + dHeight := MousePos.Y-LastMovePoint.Y; case ResizeType of RESIZETYPE_VERTICAL: dWidth := 0; @@ -4142,17 +4312,16 @@ begin RESIZEDIR_LEFT: dWidth := -dWidth; end; - ResizeObject(SelectedObjects[GetFirstSelected].ObjectType, - SelectedObjects[GetFirstSelected].ID, - dWidth, dHeight, ResizeDirection); - - LastMovePoint := MousePos; + if ResizeObject(SelectedObjects[GetFirstSelected].ObjectType, + SelectedObjects[GetFirstSelected].ID, + dWidth, dHeight, ResizeDirection) then + LastMovePoint := MousePos; end; end; end; // Зажата только левая кнопка мыши: - if (not MouseRDown) and (MouseLDown) then + if (not MouseRDown) and (MouseLDown) and (not MouseMDown) then begin // Рисуем прямоугольник планирования панели: if MouseAction in [MOUSEACTION_DRAWPANEL, @@ -4192,6 +4361,18 @@ begin 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; @@ -4203,7 +4384,7 @@ end; 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; @@ -4217,9 +4398,10 @@ end; procedure TMainForm.FormDestroy(Sender: TObject); var config: TConfig; + s: AnsiString; i: Integer; begin - config := TConfig.CreateFile(EditorDir+'Editor.cfg'); + config := TConfig.CreateFile(CfgFileName); if WindowState <> wsMaximized then begin @@ -4251,14 +4433,18 @@ begin config.WriteInt('Editor', 'MonsterRectAlpha', gAlphaMonsterRect); config.WriteInt('Editor', 'AreaRectAlpha', gAlphaAreaRect); - for i := 0 to RecentCount-1 do - if i < RecentFiles.Count then - config.WriteStr('RecentFiles', IntToStr(i+1), RecentFiles[i]) - else - config.WriteStr('RecentFiles', IntToStr(i+1), ''); + for i := 0 to RecentCount - 1 do + begin + if i < RecentFiles.Count then s := RecentFiles[i] else s := ''; + {$IFDEF WINDOWS} + config.WriteStr('RecentFilesWin', IntToStr(i), s); + {$ELSE} + config.WriteStr('RecentFilesUnix', IntToStr(i), s); + {$ENDIF} + end; RecentFiles.Free(); - config.SaveFile(EditorDir+'Editor.cfg'); + config.SaveFile(CfgFileName); config.Free(); slInvalidTextures.Free; @@ -4284,6 +4470,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; @@ -4302,34 +4504,52 @@ begin AboutForm.ShowModal(); end; -procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); +procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var dx, dy, i: Integer; FileName: String; + ok: Boolean; begin if (not EditingProperties) then begin - if Key = Ord('1') then - SwitchLayer(LAYER_BACK); - if Key = Ord('2') then - SwitchLayer(LAYER_WALLS); - if Key = Ord('3') then - SwitchLayer(LAYER_FOREGROUND); - if Key = Ord('4') then - SwitchLayer(LAYER_STEPS); - if Key = Ord('5') then - SwitchLayer(LAYER_WATER); - if Key = Ord('6') then - SwitchLayer(LAYER_ITEMS); - if Key = Ord('7') then - SwitchLayer(LAYER_MONSTERS); - if Key = Ord('8') then - SwitchLayer(LAYER_AREAS); - if Key = Ord('9') then - SwitchLayer(LAYER_TRIGGERS); - if Key = Ord('0') then - tbShowClick(tbShow); + if ssCtrl in Shift then + begin + case Chr(Key) of + '1': ContourEnabled[LAYER_BACK] := not ContourEnabled[LAYER_BACK]; + '2': ContourEnabled[LAYER_WALLS] := not ContourEnabled[LAYER_WALLS]; + '3': ContourEnabled[LAYER_FOREGROUND] := not ContourEnabled[LAYER_FOREGROUND]; + '4': ContourEnabled[LAYER_STEPS] := not ContourEnabled[LAYER_STEPS]; + '5': ContourEnabled[LAYER_WATER] := not ContourEnabled[LAYER_WATER]; + '6': ContourEnabled[LAYER_ITEMS] := not ContourEnabled[LAYER_ITEMS]; + '7': ContourEnabled[LAYER_MONSTERS] := not ContourEnabled[LAYER_MONSTERS]; + '8': ContourEnabled[LAYER_AREAS] := not ContourEnabled[LAYER_AREAS]; + '9': ContourEnabled[LAYER_TRIGGERS] := not ContourEnabled[LAYER_TRIGGERS]; + '0': + begin + ok := False; + for i := Low(ContourEnabled) to High(ContourEnabled) do + if ContourEnabled[i] then + ok := True; + for i := Low(ContourEnabled) to High(ContourEnabled) do + ContourEnabled[i] := not ok + end + end + end + else + begin + case Chr(key) of + '1': SwitchLayer(LAYER_BACK); + '2': SwitchLayer(LAYER_WALLS); + '3': SwitchLayer(LAYER_FOREGROUND); + '4': SwitchLayer(LAYER_STEPS); + '5': SwitchLayer(LAYER_WATER); + '6': SwitchLayer(LAYER_ITEMS); + '7': SwitchLayer(LAYER_MONSTERS); + '8': SwitchLayer(LAYER_AREAS); + '9': SwitchLayer(LAYER_TRIGGERS); + '0': tbShowClick(tbShow); + end + end; if Key = Ord('V') then begin // Поворот монстров и областей: @@ -4382,24 +4602,42 @@ begin begin if Key = Ord('W') then begin - if (MouseLDown or MouseRDown) and (Position >= DotStep) then + dy := Position; + if ssShift in Shift then Position := EnsureRange(Position - DotStep * 4, Min, Max) + else Position := EnsureRange(Position - DotStep, Min, Max); + MapOffset.Y := -Position; + dy -= Position; + + if (MouseLDown or MouseRDown) then begin - Dec(WASDOffset.Y, DotStep); + if DrawRect <> nil then + begin + Inc(MouseLDownPos.y, dy); + Inc(MouseRDownPos.y, dy); + end; + Inc(LastMovePoint.Y, dy); RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y); end; - Position := IfThen(Position > DotStep, Position-DotStep, 0); - MapOffset.Y := -Round(Position/16) * 16; end; if Key = Ord('S') then begin - if (MouseLDown or MouseRDown) and (Position+DotStep <= Max) then + dy := Position; + if ssShift in Shift then Position := EnsureRange(Position + DotStep * 4, Min, Max) + else Position := EnsureRange(Position + DotStep, Min, Max); + MapOffset.Y := -Position; + dy -= Position; + + if (MouseLDown or MouseRDown) then begin - Inc(WASDOffset.Y, DotStep); + if DrawRect <> nil then + begin + Inc(MouseLDownPos.y, dy); + Inc(MouseRDownPos.y, dy); + end; + Inc(LastMovePoint.Y, dy); RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y); end; - Position := IfThen(Position+DotStep < Max, Position+DotStep, Max); - MapOffset.Y := -Round(Position/16) * 16; end; end; @@ -4408,24 +4646,42 @@ begin begin if Key = Ord('A') then begin - if (MouseLDown or MouseRDown) and (Position >= DotStep) then + dx := Position; + if ssShift in Shift then Position := EnsureRange(Position - DotStep * 4, Min, Max) + else Position := EnsureRange(Position - DotStep, Min, Max); + MapOffset.X := -Position; + dx -= Position; + + if (MouseLDown or MouseRDown) then begin - Dec(WASDOffset.X, DotStep); + if DrawRect <> nil then + begin + Inc(MouseLDownPos.x, dx); + Inc(MouseRDownPos.x, dx); + end; + Inc(LastMovePoint.X, dx); RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y); end; - Position := IfThen(Position > DotStep, Position-DotStep, 0); - MapOffset.X := -Round(Position/16) * 16; end; if Key = Ord('D') then begin - if (MouseLDown or MouseRDown) and (Position+DotStep <= Max) then + dx := Position; + if ssShift in Shift then Position := EnsureRange(Position + DotStep * 4, Min, Max) + else Position := EnsureRange(Position + DotStep, Min, Max); + MapOffset.X := -Position; + dx -= Position; + + if (MouseLDown or MouseRDown) then begin - Inc(WASDOffset.X, DotStep); + if DrawRect <> nil then + begin + Inc(MouseLDownPos.x, dx); + Inc(MouseRDownPos.x, dx); + end; + Inc(LastMovePoint.X, dx); RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y); end; - Position := IfThen(Position+DotStep < Max, Position+DotStep, Max); - MapOffset.X := -Round(Position/16) * 16; end; end; end @@ -4644,6 +4900,21 @@ begin end; end; +procedure TMainForm.miMacMinimizeClick(Sender: TObject); +begin + self.WindowState := wsMinimized; + self.FormWindowStateChange(Sender); +end; + +procedure TMainForm.miMacZoomClick(Sender: TObject); +begin + if self.WindowState = wsMaximized then + self.WindowState := wsNormal + else + self.WindowState := wsMaximized; + self.FormWindowStateChange(Sender); +end; + procedure TMainForm.miReopenMapClick(Sender: TObject); var FileName, Resource: String; @@ -4651,7 +4922,7 @@ begin 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; @@ -4735,6 +5006,16 @@ begin Values.Add(_lc[I_PROP_TR_SHOT_AIM_2]); Values.Add(_lc[I_PROP_TR_SHOT_AIM_3]); end + else if KeyName = _lc[I_PROP_TR_DAMAGE_KIND] then + begin + Values.Add(_lc[I_PROP_TR_DAMAGE_KIND_0]); + Values.Add(_lc[I_PROP_TR_DAMAGE_KIND_3]); + Values.Add(_lc[I_PROP_TR_DAMAGE_KIND_4]); + Values.Add(_lc[I_PROP_TR_DAMAGE_KIND_5]); + Values.Add(_lc[I_PROP_TR_DAMAGE_KIND_6]); + Values.Add(_lc[I_PROP_TR_DAMAGE_KIND_7]); + Values.Add(_lc[I_PROP_TR_DAMAGE_KIND_8]); + end else if (KeyName = _lc[I_PROP_PANEL_BLEND]) or (KeyName = _lc[I_PROP_DM_ONLY]) or (KeyName = _lc[I_PROP_ITEM_FALLS]) or @@ -5071,7 +5352,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: @@ -5138,6 +5419,21 @@ begin StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_DAMAGE_VALUE]], 0), 0), 65535); Data.DamageInterval := Min(Max( StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_INTERVAL]], 0), 0), 65535); + s := vleObjectProperty.Values[_lc[I_PROP_TR_DAMAGE_KIND]]; + if s = _lc[I_PROP_TR_DAMAGE_KIND_3] then + Data.DamageKind := 3 + else if s = _lc[I_PROP_TR_DAMAGE_KIND_4] then + Data.DamageKind := 4 + else if s = _lc[I_PROP_TR_DAMAGE_KIND_5] then + Data.DamageKind := 5 + else if s = _lc[I_PROP_TR_DAMAGE_KIND_6] then + Data.DamageKind := 6 + else if s = _lc[I_PROP_TR_DAMAGE_KIND_7] then + Data.DamageKind := 7 + else if s = _lc[I_PROP_TR_DAMAGE_KIND_8] then + Data.DamageKind := 8 + else + Data.DamageKind := 0; end; TRIGGER_HEALTH: @@ -5256,7 +5552,7 @@ begin 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 @@ -5282,10 +5578,7 @@ end; 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; @@ -6129,17 +6422,18 @@ begin 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; @@ -6150,69 +6444,47 @@ end; procedure TMainForm.aDeleteMap(Sender: TObject); var - WAD: TWADEditor_1; - MapList: SArray; - MapName: Char16; - a: Integer; - str: String; + res: Integer; + FileName: String; + MapName: String; begin OpenDialog.Filter := _lc[I_FILE_FILTER_WAD]; if not OpenDialog.Execute() then Exit; - WAD := TWADEditor_1.Create(); - - if not WAD.ReadFile(OpenDialog.FileName) then - begin - WAD.Free(); - Exit; - end; - - WAD.CreateImage(); - - MapList := WAD.GetResourcesList(''); - + FileName := OpenDialog.FileName; SelectMapForm.Caption := _lc[I_CAP_REMOVE]; SelectMapForm.lbMapList.Items.Clear(); + SelectMapForm.GetMaps(FileName); + + if SelectMapForm.ShowModal() <> mrOK then + Exit; - if MapList <> nil then - for a := 0 to High(MapList) do - SelectMapForm.lbMapList.Items.Add(win2utf(MapList[a])); + MapName := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex]; + 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; - if (SelectMapForm.ShowModal() = mrOK) then + g_DeleteResource(FileName, '', MapName, res); + if res <> 0 then begin - str := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex]; - MapName := ''; - Move(str[1], MapName[0], Min(16, Length(str))); - - 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 - Exit; - - WAD.RemoveResource('', utf2win(MapName)); - - MessageBox(0, PChar(Format(_lc[I_MSG_MAP_DELETED_PROMT], - [MapName])), - PChar(_lc[I_MSG_MAP_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; - WAD.SaveTo(OpenDialog.FileName); + 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 + ); // Удалили текущую карту - сохранять по старому ее нельзя: - if OpenedMap = (OpenDialog.FileName+':\'+MapName) then - begin - OpenedMap := ''; - OpenedWAD := ''; - MainForm.Caption := FormCaption; - end; - end; - - WAD.Free(); + if OpenedMap = (FileName + ':\' + MapName) then + begin + OpenedMap := ''; + OpenedWAD := ''; + MainForm.Caption := FormCaption + end end; procedure TMainForm.vleObjectPropertyKeyDown(Sender: TObject; @@ -6438,6 +6710,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 @@ -6453,6 +6726,12 @@ begin MainForm.FormResize(nil); end; Draw(); + if StartMap <> '' then + begin + f := StartMap; + StartMap := ''; + OpenMap(f, ''); + end; end; procedure TMainForm.miMapPreviewClick(Sender: TObject); @@ -6612,40 +6891,73 @@ begin PackMapForm.ShowModal(); end; -procedure TMainForm.miMapTestSettingsClick(Sender: TObject); +type SSArray = array of String; + +function ParseString (Str: AnsiString): SSArray; + function GetStr (var Str: AnsiString): AnsiString; + var a, b: Integer; + begin + Result := ''; + if Str[1] = '"' then + for b := 1 to Length(Str) do + if (b = Length(Str)) or (Str[b + 1] = '"') then + begin + Result := Copy(Str, 2, b - 1); + Delete(Str, 1, b + 1); + Str := Trim(Str); + Exit; + end; + for a := 1 to Length(Str) do + if (a = Length(Str)) or (Str[a + 1] = ' ') then + begin + Result := Copy(Str, 1, a); + Delete(Str, 1, a + 1); + Str := Trim(Str); + Exit; + end; + end; begin - MapTestForm.ShowModal(); + Result := nil; + Str := Trim(Str); + while Str <> '' do + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)] := GetStr(Str); + end; end; procedure TMainForm.miTestMapClick(Sender: TObject); var - cmd, mapWAD, mapToRun, tempWAD: String; + newWAD, oldWAD, tempMap, ext: String; + args: SSArray; opt: LongWord; - time: Integer; + 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; @@ -6660,23 +6972,32 @@ begin if TestOptionsMonstersDM then opt := opt + 16; -// Составляем командную строку: - cmd := '-map "' + mapToRun + '"'; - cmd := cmd + ' -testmap "' + tempWAD + '"'; - cmd := cmd + ' -gm ' + TestGameMode; - cmd := cmd + ' -limt ' + TestLimTime; - cmd := cmd + ' -lims ' + TestLimScore; - cmd := cmd + ' -opt ' + IntToStr(opt); - - if TestMapOnce then - cmd := cmd + ' --close'; - - cmd := cmd + ' --debug'; - // Запускаем: proc := TProcessUTF8.Create(nil); proc.Executable := TestD2dExe; - proc.Parameters.Add(cmd); + {$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(tempMap); + proc.Parameters.Add('-gm'); + proc.Parameters.Add(TestGameMode); + proc.Parameters.Add('-limt'); + proc.Parameters.Add(TestLimTime); + proc.Parameters.Add('-lims'); + proc.Parameters.Add(TestLimScore); + proc.Parameters.Add('-opt'); + proc.Parameters.Add(IntToStr(opt)); + proc.Parameters.Add('--debug'); + if TestMapOnce then + proc.Parameters.Add('--close'); + + args := ParseString(TestD2DArgs); + for i := 0 to High(args) do + proc.Parameters.Add(args[i]); + res := True; try proc.Execute(); @@ -6685,31 +7006,28 @@ 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; ScrollCode: TScrollCode; var ScrollPos: Integer); begin - MapOffset.Y := -Normalize16(sbVertical.Position); + MapOffset.Y := -sbVertical.Position; end; procedure TMainForm.sbHorizontalScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin - MapOffset.X := -Normalize16(sbHorizontal.Position); + MapOffset.X := -sbHorizontal.Position; end; procedure TMainForm.miOpenWadMapClick(Sender: TObject); @@ -6776,8 +7094,7 @@ begin EditingProperties := False; end; -procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); +procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin // Объекты передвигались: if MainForm.ActiveControl = RenderPanel then