X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_main.pas;h=d40610abd027e358c38bd3916a6ba3f53c979e57;hb=HEAD;hp=53bf85da742cf26b936bb5276e2694763f6bc7ea;hpb=dd6a8c0ae0c61fbd1d070e83b5d54c41edeb6df8;p=d2df-editor.git diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index 53bf85d..d40610a 100644 --- a/src/editor/f_main.pas +++ b/src/editor/f_main.pas @@ -271,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); @@ -349,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; @@ -1825,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(); @@ -2370,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 @@ -2416,6 +2429,7 @@ var end; begin + minArea := High(minArea); Str := Trim(Str); if GetNext() <> CLIPBOARD_SIG then @@ -2426,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); @@ -2453,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; @@ -2469,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: @@ -2481,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: @@ -2496,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: @@ -2510,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; @@ -2561,13 +2554,15 @@ end; procedure TMainForm.miRecentFileExecute (Sender: TObject); var s, fn: AnsiString; + n: LongInt; begin - s := RecentFiles[(Sender as TMenuItem).Tag]; + n := (Sender as TMenuItem).Tag; + s := RecentFiles[n]; fn := g_ExtractWadName(s); if FileExists(fn) then OpenMap(fn, g_ExtractFilePathName(s)) else - Application.MessageBox('', 'File not available anymore', MB_OK); + 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); @@ -2592,7 +2587,7 @@ begin else begin menu.Delete(i); - MI.Destroy(); + Application.ReleaseComponent(MI); end; end; @@ -2649,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); @@ -2666,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); @@ -2684,6 +2686,7 @@ var s: String; begin Randomize(); + LastDrawTime := 0; {$IFDEF DARWIN} miApple.Enabled := True; @@ -2769,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 @@ -2822,9 +2827,6 @@ begin 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'); @@ -2878,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; @@ -2888,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, @@ -2944,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; // Превью текстуры: @@ -3397,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; @@ -3775,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; @@ -4340,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)', @@ -4371,6 +4402,8 @@ var begin config := TConfig.CreateFile(CfgFileName); + config.WriteInt('WADEditor', 'LogLevel', gWADEditorLogLevel); + if WindowState <> wsMaximized then begin config.WriteInt('Editor', 'XPos', Left); @@ -4416,7 +4449,8 @@ begin config.SaveFile(CfgFileName); config.Free(); - slInvalidTextures.Free; + slInvalidTextures.Free(); + DiscardUndoBuffer(); end; procedure TMainForm.FormDropFiles(Sender: TObject; @@ -4667,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(); // Снять выделение: @@ -5567,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); @@ -5582,9 +5615,7 @@ begin end; SetLength(UndoBuffer, Length(UndoBuffer)-1); - RemoveSelectFromObjects(); - miUndo.Enabled := UndoBuffer <> nil; end; @@ -5815,15 +5846,16 @@ begin h := High(CopyBuffer); RemoveSelectFromObjects(); - if h > 0 then + if g_CollidePoint( + pmin.X, pmin.Y, -MapOffset.X-32, -MapOffset.Y-32, RenderPanel.Width, RenderPanel.Height) then begin - xadj := Floor((-pmin.X - MapOffset.X + 32) / DotStep) * DotStep; - yadj := Floor((-pmin.Y - MapOffset.Y + 32) / DotStep) * DotStep; + xadj := DotStep; + yadj := DotStep; end else begin - xadj := DotStep; - yadj := DotStep; + 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 @@ -6207,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); @@ -6347,7 +6379,7 @@ begin g_ProcessResourceStr(OpenedMap, FileName, Section, Res); - SaveMap(FileName+':\'+Res); + SaveMap(FileName+':\'+Res, ''); end; procedure TMainForm.aOpenMapExecute(Sender: TObject); @@ -6394,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(MsgMsgDeleteMapPrompt, [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(); - g_DeleteResource(FileName, '', MapName, res); - if res <> 0 then + if MapList <> nil then + for a := 0 to High(MapList) do + SelectMapForm.lbMapList.Items.Add(win2utf(MapList[a])); + + 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(MsgMsgMapDeletedPrompt, [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; @@ -6585,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; - - if not SaveDialog.Execute() then - Exit; + list := TStringList.Create(); - 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); @@ -6660,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; @@ -6907,7 +6974,7 @@ begin newWad := newWad + '.wad' end; tempMap := newWAD + ':\' + TEST_MAP_NAME; - SaveMap(tempMap); + SaveMap(tempMap, ''); // Опции игры: opt := 32 + 64;