X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_main.pas;h=d40610abd027e358c38bd3916a6ba3f53c979e57;hb=HEAD;hp=591b7e060f9405b89d54aadc8fc1791189bb3ca1;hpb=caaa041f34124f7be0c8915e10f7849c4a030b1d;p=d2df-editor.git diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index 591b7e0..d40610a 100644 --- a/src/editor/f_main.pas +++ b/src/editor/f_main.pas @@ -215,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); @@ -270,6 +271,7 @@ type procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); private + LastDrawTime: UInt64; procedure Draw(); procedure OnIdle(Sender: TObject; var Done: Boolean); procedure RefillRecentMenu (menu: TMenuItem; start: Integer; fmt: AnsiString); @@ -348,10 +350,10 @@ uses f_mapoptions, g_basic, f_about, f_mapoptimization, f_mapcheck, f_addresource_texture, g_textures, f_activationtype, f_keys, wadreader, fileutil, - MAPREADER, f_selectmap, f_savemap, WADEDITOR, MAPDEF, + MAPREADER, f_selectmap, f_savemap, WADEDITOR, WADSTRUCT, MAPDEF, g_map, f_saveminimap, f_addresource, CONFIG, f_packmap, f_addresource_sound, f_choosetype, - g_language, ClipBrd, g_resources, g_options; + g_language, ClipBrd, g_options; const UNDO_DELETE_PANEL = 1; @@ -407,8 +409,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); @@ -429,9 +430,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); @@ -1826,16 +1826,28 @@ begin end; UndoBuffer[i, ii].AddID := ID; - MainForm.miUndo.Enabled := UndoBuffer <> nil; end; +procedure DiscardUndoBuffer(); +var + i, k: Integer; +begin + for i := 0 to High(UndoBuffer) do + for k := 0 to High(UndoBuffer[i]) do + with UndoBuffer[i][k] do + if UndoType = UNDO_DELETE_PANEL then + Dispose(Panel); + + UndoBuffer := nil; +end; + procedure FullClear(); begin RemoveSelectFromObjects(); ClearMap(); LoadSky(gMapInfo.SkyName); - UndoBuffer := nil; + DiscardUndoBuffer(); slInvalidTextures.Clear(); MapCheckForm.lbErrorList.Clear(); MapCheckForm.mErrorDescription.Clear(); @@ -2371,10 +2383,10 @@ begin Result := Res; end; -procedure StringToCopyBuffer(Str: String; var CopyBuf: TCopyRecArray; - var pmin: TPoint); +procedure StringToCopyBuffer(Str: String; var CopyBuf: TCopyRecArray; var pmin: TPoint); var i, j, t: Integer; + minArea, newArea, newX, newY: LongInt; function GetNext(): String; var @@ -2417,6 +2429,7 @@ var end; begin + minArea := High(minArea); Str := Trim(Str); if GetNext() <> CLIPBOARD_SIG then @@ -2427,8 +2440,7 @@ begin // Тип объекта: t := StrToIntDef(GetNext(), 0); - if (t < OBJECT_PANEL) or (t > OBJECT_TRIGGER) or - (GetNext() <> ';') then + if (t < OBJECT_PANEL) or (t > OBJECT_TRIGGER) or (GetNext() <> ';') then begin // Что-то не то => пропускаем: t := Pos(';', Str); Delete(Str, 1, t); @@ -2454,13 +2466,14 @@ begin PanelType := StrToIntDef(GetNext(), PANEL_WALL); X := StrToIntDef(GetNext(), 0); Y := StrToIntDef(GetNext(), 0); - pmin.X := Min(X, pmin.X); - pmin.Y := Min(Y, pmin.Y); Width := StrToIntDef(GetNext(), 16); Height := StrToIntDef(GetNext(), 16); TextureName := GetNext(); Alpha := StrToIntDef(GetNext(), 0); Blending := (GetNext() = '1'); + newArea := X * Y - Width * Height; + newX := X; + newY := Y; end; end; @@ -2470,10 +2483,11 @@ begin ItemType := StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL); X := StrToIntDef(GetNext(), 0); Y := StrToIntDef(GetNext(), 0); - pmin.X := Min(X, pmin.X); - pmin.Y := Min(Y, pmin.Y); OnlyDM := (GetNext() = '1'); Fall := (GetNext() = '1'); + newArea := X * Y; + newX := X; + newY := Y; end; OBJECT_MONSTER: @@ -2482,13 +2496,12 @@ begin MonsterType := StrToIntDef(GetNext(), MONSTER_DEMON); X := StrToIntDef(GetNext(), 0); Y := StrToIntDef(GetNext(), 0); - pmin.X := Min(X, pmin.X); - pmin.Y := Min(Y, pmin.Y); - - if GetNext() = '1' then - Direction := D_LEFT - else - Direction := D_RIGHT; + if GetNext() = '1' + then Direction := D_LEFT + else Direction := D_RIGHT; + newArea := X * Y; + newX := X; + newY := Y; end; OBJECT_AREA: @@ -2497,12 +2510,12 @@ begin AreaType := StrToIntDef(GetNext(), AREA_PLAYERPOINT1); X := StrToIntDef(GetNext(), 0); Y := StrToIntDef(GetNext(), 0); - pmin.X := Min(X, pmin.X); - pmin.Y := Min(Y, pmin.Y); - if GetNext() = '1' then - Direction := D_LEFT - else - Direction := D_RIGHT; + if GetNext() = '1' + then Direction := D_LEFT + else Direction := D_RIGHT; + newArea := X * Y; + newX := X; + newY := Y; end; OBJECT_TRIGGER: @@ -2511,47 +2524,26 @@ begin TriggerType := StrToIntDef(GetNext(), TRIGGER_EXIT); X := StrToIntDef(GetNext(), 0); Y := StrToIntDef(GetNext(), 0); - pmin.X := Min(X, pmin.X); - pmin.Y := Min(Y, pmin.Y); Width := StrToIntDef(GetNext(), 16); Height := StrToIntDef(GetNext(), 16); ActivateType := StrToIntDef(GetNext(), 0); Key := StrToIntDef(GetNext(), 0); Enabled := (GetNext() = '1'); TexturePanel := StrToIntDef(GetNext(), 0); - - for j := 0 to 127 do - Data.Default[j] := StrToIntDef(GetNext(), 0); - - case TriggerType of - TRIGGER_TELEPORT: - begin - pmin.X := Min(Data.TargetPoint.X, pmin.X); - pmin.Y := Min(Data.TargetPoint.Y, pmin.Y); - end; - TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF: - begin - pmin.X := Min(Data.tX, pmin.X); - pmin.Y := Min(Data.tY, pmin.Y); - end; - TRIGGER_SPAWNMONSTER: - begin - pmin.X := Min(Data.MonPos.X, pmin.X); - pmin.Y := Min(Data.MonPos.Y, pmin.Y); - end; - TRIGGER_SPAWNITEM: - begin - pmin.X := Min(Data.ItemPos.X, pmin.X); - pmin.Y := Min(Data.ItemPos.Y, pmin.Y); - end; - TRIGGER_SHOT: - begin - pmin.X := Min(Data.ShotPos.X, pmin.X); - pmin.Y := Min(Data.ShotPos.Y, pmin.Y); - end; - end; + for j := 0 to 127 + do Data.Default[j] := StrToIntDef(GetNext(), 0); + newArea := X * Y - Width * Height; + newX := X; + newY := Y; end; end; + + if newArea < minArea then + begin + minArea := newArea; + pmin.X := newX; + pmin.Y := newY; + end; end; end; @@ -2559,32 +2551,19 @@ 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; + n: LongInt; begin - fn := g_ExtractWadName(FPath); + n := (Sender as TMenuItem).Tag; + s := RecentFiles[n]; + 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 + Application.MessageBox('File not available anymore', '', MB_OK); +// if Application.MessageBox(PChar(MsgMsgDelRecentPrompt), PChar(MsgMsgDelRecent), MB_ICONQUESTION or MB_YESNO) = idYes then // begin // RecentFiles.Delete(n); // RefreshRecentMenu(); @@ -2592,40 +2571,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); + Application.ReleaseComponent(MI); + 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; @@ -2647,7 +2621,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; @@ -2670,13 +2644,21 @@ var cwdt, chgt: Byte; spc: ShortInt; ID: DWORD; + wad: TWADEditor_1; cfgdata: Pointer; cfglen: Integer; config: TConfig; begin + cfgdata := nil; + cfglen := 0; ID := 0; - g_ReadResource(GameWad, 'FONTS', cfgres, cfgdata, cfglen); - if cfgdata <> nil then + + wad := TWADEditor_1.Create; + if wad.ReadFile(GameWad) then + wad.GetResource('FONTS', cfgres, cfgdata, cfglen); + wad.Free(); + + if cfglen <> 0 then begin if not g_CreateTextureWAD('FONT_STD', GameWad + ':FONTS\' + texture) then e_WriteLog('ERROR ERROR ERROR', MSG_WARNING); @@ -2687,15 +2669,14 @@ 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 - begin - e_WriteLog('Could not load FONT_STD', MSG_WARNING) - end + e_WriteLog('Could not load FONT_STD', MSG_WARNING); + + if cfglen <> 0 then FreeMem(cfgdata); end; procedure TMainForm.FormCreate(Sender: TObject); @@ -2705,6 +2686,7 @@ var s: String; begin Randomize(); + LastDrawTime := 0; {$IFDEF DARWIN} miApple.Enabled := True; @@ -2790,6 +2772,8 @@ begin config := TConfig.CreateFile(CfgFileName); + gWADEditorLogLevel := config.ReadInt('WADEditor', 'LogLevel', DFWAD_LOG_DEFAULT); + if config.ReadInt('Editor', 'XPos', -1) = -1 then Position := poDesktopCenter else begin @@ -2835,23 +2819,14 @@ 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); 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'); @@ -2905,6 +2880,23 @@ begin e_TextureFontPrintEx(X, Y, Text, FontID, 0, 0, 0, 1.0); end; +procedure InitGraphics; +begin + // FIXME: this is a shitty hack + if not gDataLoaded then + begin + e_WriteLog('Init OpenGL', MSG_NOTIFY); + 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; +end; + procedure TMainForm.Draw(); var x, y: Integer; @@ -2915,11 +2907,14 @@ var ObjCount: Word; aX, aY, aX2, aY2, XX, ScaleSz: Integer; begin + LastDrawTime := GetTickCount64(); ID := 0; PID := 0; Width := 0; Height := 0; + InitGraphics(); + e_BeginRender(); e_Clear(GL_COLOR_BUFFER_BIT, @@ -2971,22 +2966,23 @@ begin else a := 0; + glDisable(GL_TEXTURE_2D); + glColor3ub(GetRValue(DotColor), GetGValue(DotColor), GetBValue(DotColor)); + glPointSize(DotSize); + glBegin(GL_POINTS); x := MapOffset.X mod DotStep; - y := MapOffset.Y mod DotStep; - while x < RenderPanel.Width do begin + y := MapOffset.Y mod DotStep; while y < RenderPanel.Height do begin - e_DrawPoint(DotSize, x + a, y + a, - GetRValue(DotColor), - GetGValue(DotColor), - GetBValue(DotColor)); + glVertex2i(x + a, y + a); y += DotStep; end; x += DotStep; - y := MapOffset.Y mod DotStep; end; + glEnd(); + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); end; // Превью текстуры: @@ -3424,7 +3420,7 @@ begin else begin item.ItemType := lbItemList.ItemIndex + ITEM_MEDKIT_SMALL; - if item.ItemType >= ITEM_WEAPON_KASTET then + if item.ItemType >= ITEM_WEAPON_IRONFIST then item.ItemType := item.ItemType + 2; item.X := MousePos.X-MapOffset.X; item.Y := MousePos.Y-MapOffset.Y; @@ -3802,7 +3798,12 @@ begin if Button = mbMiddle then MouseMDown := False; - DrawRect := nil; + if DrawRect <> nil then + begin + Dispose(DrawRect); + DrawRect := nil; + end; + ResizeType := RESIZETYPE_NONE; TextureID := 0; @@ -4367,8 +4368,11 @@ begin end; // Клавиши мыши не зажаты: - if (not MouseRDown) and (not MouseLDown) then + if (not MouseRDown) and (not MouseLDown) and (DrawRect <> nil) then + begin + Dispose(DrawRect); DrawRect := nil; + end; // Строка состояния - координаты мыши: StatusBar.Panels[1].Text := Format('(%d:%d)', @@ -4379,7 +4383,7 @@ end; procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin - CanClose := Application.MessageBox(PChar(MsgMsgExitPromt), + CanClose := Application.MessageBox(PChar(MsgMsgExitPrompt), PChar(MsgMsgExit), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON1) = idYes; @@ -4398,6 +4402,8 @@ var begin config := TConfig.CreateFile(CfgFileName); + config.WriteInt('WADEditor', 'LogLevel', gWADEditorLogLevel); + if WindowState <> wsMaximized then begin config.WriteInt('Editor', 'XPos', Left); @@ -4443,7 +4449,8 @@ begin config.SaveFile(CfgFileName); config.Free(); - slInvalidTextures.Free; + slInvalidTextures.Free(); + DiscardUndoBuffer(); end; procedure TMainForm.FormDropFiles(Sender: TObject; @@ -4547,7 +4554,7 @@ begin end end; - if Key = Ord('V') then + if Key = Ord('I') then begin // Поворот монстров и областей: if (SelectedObjects <> nil) then begin @@ -4694,8 +4701,7 @@ begin end; // Удалить выделенные объекты: - if (Key = VK_DELETE) and (SelectedObjects <> nil) and - RenderPanel.Focused() then + if (Key = VK_DELETE) and (SelectedObjects <> nil) and RenderPanel.Focused() then DeleteSelectedObjects(); // Снять выделение: @@ -4918,7 +4924,7 @@ begin if OpenedMap = '' then Exit; - if Application.MessageBox(PChar(MsgMsgReopenMapPromt), + if Application.MessageBox(PChar(MsgMsgReopenMapPrompt), PChar(MsgMenuFileReopen), MB_ICONQUESTION or MB_YESNO) <> idYes then Exit; @@ -5548,7 +5554,7 @@ begin if i = -1 then Exit; - if Application.MessageBox(PChar(Format(MsgMsgDelTexturePromt, + if Application.MessageBox(PChar(Format(MsgMsgDelTexturePrompt, [SelectedTexture()])), PChar(MsgMsgDelTexture), MB_ICONQUESTION or MB_YESNO or @@ -5574,7 +5580,7 @@ end; procedure TMainForm.aNewMapExecute(Sender: TObject); begin - if Application.MessageBox(PChar(MsgMsgClearMapPromt), PChar(MsgMsgClearMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON1) = mrYes then + if Application.MessageBox(PChar(MsgMsgClearMapPrompt), PChar(MsgMsgClearMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON1) = mrYes then FullClear(); end; @@ -5594,7 +5600,7 @@ begin UNDO_DELETE_PANEL: begin AddPanel(Panel^); - Panel := nil; + Dispose(Panel); end; UNDO_DELETE_ITEM: AddItem(Item); UNDO_DELETE_AREA: AddArea(Area); @@ -5609,9 +5615,7 @@ begin end; SetLength(UndoBuffer, Length(UndoBuffer)-1); - RemoveSelectFromObjects(); - miUndo.Enabled := UndoBuffer <> nil; end; @@ -5721,7 +5725,7 @@ begin QuickSortCopyBuffer(0, b); end; -// Пестановка ссылок триггеров: +// Постановка ссылок триггеров: for a := 0 to Length(CopyBuffer)-1 do if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then begin @@ -5826,21 +5830,34 @@ 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 g_CollidePoint( + pmin.X, pmin.Y, -MapOffset.X-32, -MapOffset.Y-32, RenderPanel.Width, RenderPanel.Height) then + begin + xadj := DotStep; + yadj := DotStep; + end + else + begin + xadj := Floor((-pmin.X - MapOffset.X + 32) / DotStep) * DotStep; + yadj := Floor((-pmin.Y - MapOffset.Y + 32) / DotStep) * DotStep; + end; + for a := 0 to h do with CopyBuffer[a] do begin @@ -5850,8 +5867,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; @@ -5909,8 +5926,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); @@ -5922,8 +5939,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); @@ -5935,8 +5952,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); @@ -5949,42 +5966,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; @@ -6230,7 +6239,7 @@ begin if ShowModal() = mrOK then begin b := lbTypeSelect.ItemIndex + ITEM_MEDKIT_SMALL; - if b >= ITEM_WEAPON_KASTET then + if b >= ITEM_WEAPON_IRONFIST then b := b + 2; Values[Key] := ItemToStr(b); vleObjectPropertyApply(Sender); @@ -6370,7 +6379,7 @@ begin g_ProcessResourceStr(OpenedMap, FileName, Section, Res); - SaveMap(FileName+':\'+Res); + SaveMap(FileName+':\'+Res, ''); end; procedure TMainForm.aOpenMapExecute(Sender: TObject); @@ -6417,47 +6426,65 @@ end; procedure TMainForm.aDeleteMap(Sender: TObject); var - res: Integer; - FileName: String; - MapName: String; + WAD: TWADEditor_1; + MapList: SArray; + MapName: Char16; + a: Integer; + str: String; begin OpenDialog.Filter := MsgFileFilterWad; if not OpenDialog.Execute() then Exit; - FileName := OpenDialog.FileName; - SelectMapForm.Caption := MsgCapRemove; - SelectMapForm.lbMapList.Items.Clear(); - SelectMapForm.GetMaps(FileName); + WAD := TWADEditor_1.Create(); - if SelectMapForm.ShowModal() <> mrOK then + if not WAD.ReadFile(OpenDialog.FileName) then + begin + WAD.Free(); Exit; + end; - MapName := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex]; - if Application.MessageBox(PChar(Format(MsgMsgDeleteMapPromt, [MapName, OpenDialog.FileName])), PChar(MsgMsgDeleteMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then - Exit; + WAD.CreateImage(); + + MapList := WAD.GetResourcesList(''); + + SelectMapForm.Caption := MsgCapRemove; + SelectMapForm.lbMapList.Items.Clear(); + + if MapList <> nil then + for a := 0 to High(MapList) do + SelectMapForm.lbMapList.Items.Add(win2utf(MapList[a])); - g_DeleteResource(FileName, '', MapName, res); - if res <> 0 then + if (SelectMapForm.ShowModal() = mrOK) then begin - Application.MessageBox(PChar('Cant delete map res=' + IntToStr(res)), PChar('Map not deleted!'), MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1); - Exit - end; + str := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex]; + MapName := ''; + Move(str[1], MapName[0], Min(16, Length(str))); + + if Application.MessageBox(PChar(Format(MsgMsgDeleteMapPrompt, [MapName, OpenDialog.FileName])), PChar(MsgMsgDeleteMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then + Exit; + + WAD.RemoveResource('', utf2win(MapName)); + + Application.MessageBox( + PChar(Format(MsgMsgMapDeletedPrompt, [MapName])), + PChar(MsgMsgMapDeleted), + MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1 + ); - Application.MessageBox( - PChar(Format(MsgMsgMapDeletedPromt, [MapName])), - PChar(MsgMsgMapDeleted), - MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1 - ); + WAD.SaveTo(OpenDialog.FileName); // Удалили текущую карту - сохранять по старому ее нельзя: - if OpenedMap = (FileName + ':\' + MapName) then - begin - OpenedMap := ''; - OpenedWAD := ''; - MainForm.Caption := FormCaption - end + if OpenedMap = (OpenDialog.FileName+':\'+MapName) then + begin + OpenedMap := ''; + OpenedWAD := ''; + MainForm.Caption := FormCaption; + end; + end; + + WAD.Free(); end; procedure TMainForm.vleObjectPropertyKeyDown(Sender: TObject; @@ -6608,35 +6635,59 @@ begin end; procedure TMainForm.aSaveMapAsExecute(Sender: TObject); -var - idx: Integer; + var i, idx: Integer; list: TStringList; fmt: String; begin - SaveDialog.Filter := MsgFileFilterWad; + list := TStringList.Create(); - if not SaveDialog.Execute() then - Exit; - - SaveMapForm.GetMaps(SaveDialog.FileName, True); + // TODO: get loclized strings automatically from language files + SaveDialog.DefaultExt := '.dfz'; + SaveDialog.FilterIndex := 1; + SaveDialog.Filter := ''; + gWADEditorFactory.GetRegistredEditors(list); + for i := 0 to list.Count - 1 do + begin + if list[i] = 'DFZIP' then + SaveDialog.FilterIndex := i + 1; - if SaveMapForm.ShowModal() <> mrOK then - Exit; + if i <> 0 then + SaveDialog.Filter := SaveDialog.Filter + '|'; - SaveDialog.InitialDir := ExtractFileDir(SaveDialog.FileName); - OpenedMap := SaveDialog.FileName+':\'+SaveMapForm.eMapName.Text; - OpenedWAD := SaveDialog.FileName; + if list[i] = 'DFWAD' then + SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFWAD + else if list[i] = 'DFZIP' then + SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFZIP + else + SaveDialog.Filter := SaveDialog.Filter + list[i] + '|*.*'; + end; - idx := RecentFiles.IndexOf(OpenedMap); -// Такая карта уже недавно открывалась: - if idx >= 0 then - RecentFiles.Delete(idx); - RecentFiles.Insert(0, OpenedMap); - RefreshRecentMenu; + if SaveDialog.Execute() then + begin + i := SaveDialog.FilterIndex - 1; + if (i >= 0) and (i < list.Count) then fmt := list[i] else fmt := ''; - SaveMap(OpenedMap); + SaveMapForm.GetMaps(SaveDialog.FileName, True, fmt); + if SaveMapForm.ShowModal() = mrOK then + begin + SaveDialog.InitialDir := ExtractFileDir(SaveDialog.FileName); + OpenedMap := SaveDialog.FileName+':\'+SaveMapForm.eMapName.Text; + OpenedWAD := SaveDialog.FileName; + + idx := RecentFiles.IndexOf(OpenedMap); + // Такая карта уже недавно открывалась: + if idx >= 0 then + RecentFiles.Delete(idx); + RecentFiles.Insert(0, OpenedMap); + RefreshRecentMenu; + + SaveMap(OpenedMap, fmt); + + gMapInfo.FileName := SaveDialog.FileName; + gMapInfo.MapName := SaveMapForm.eMapName.Text; + UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName); + end; + end; - gMapInfo.FileName := SaveDialog.FileName; - gMapInfo.MapName := SaveMapForm.eMapName.Text; - UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName); + list.Free(); end; procedure TMainForm.aSelectAllExecute(Sender: TObject); @@ -6683,22 +6734,15 @@ begin end; procedure TMainForm.OnIdle(Sender: TObject; var Done: Boolean); + const MaxFPS = 60; var f: AnsiString; begin - // FIXME: this is a shitty hack - if not gDataLoaded then + // TODO: move refresh to user actions (ask to repaint only when something changed) + if GetTickCount64() - LastDrawTime >= 1000 div MaxFPS then begin - e_WriteLog('Init OpenGL', MSG_NOTIFY); - 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); + PanelMap.Refresh; end; - Draw(); + if StartMap <> '' then begin f := StartMap; @@ -6930,7 +6974,7 @@ begin newWad := newWad + '.wad' end; tempMap := newWAD + ':\' + TEST_MAP_NAME; - SaveMap(tempMap); + SaveMap(tempMap, ''); // Опции игры: opt := 32 + 64;