diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index eb2348e2d5016a7e5f669fe3397fb4ff4fa8ca5f..d40610abd027e358c38bd3916a6ba3f53c979e57 100644 (file)
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
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);
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);
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;
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();
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
end;
begin
+ minArea := High(minArea);
Str := Trim(Str);
if GetNext() <> CLIPBOARD_SIG then
// Тип объекта:
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);
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;
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:
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:
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:
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;
//Закончились вспомогательные процедуры
//----------------------------------------
-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();
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;
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;
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);
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);
s: String;
begin
Randomize();
+ LastDrawTime := 0;
{$IFDEF DARWIN}
miApple.Enabled := True;
config := TConfig.CreateFile(CfgFileName);
+ gWADEditorLogLevel := config.ReadInt('WADEditor', 'LogLevel', DFWAD_LOG_DEFAULT);
+
if config.ReadInt('Editor', 'XPos', -1) = -1 then
Position := poDesktopCenter
else 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');
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;
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,
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;
// Превью текстуры:
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;
if Button = mbMiddle then
MouseMDown := False;
- DrawRect := nil;
+ if DrawRect <> nil then
+ begin
+ Dispose(DrawRect);
+ DrawRect := nil;
+ end;
+
ResizeType := RESIZETYPE_NONE;
TextureID := 0;
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)',
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;
begin
config := TConfig.CreateFile(CfgFileName);
+ config.WriteInt('WADEditor', 'LogLevel', gWADEditorLogLevel);
+
if WindowState <> wsMaximized then
begin
config.WriteInt('Editor', 'XPos', Left);
config.SaveFile(CfgFileName);
config.Free();
- slInvalidTextures.Free;
+ slInvalidTextures.Free();
+ DiscardUndoBuffer();
end;
procedure TMainForm.FormDropFiles(Sender: TObject;
end;
// Удалить выделенные объекты:
- if (Key = VK_DELETE) and (SelectedObjects <> nil) and
- RenderPanel.Focused() then
+ if (Key = VK_DELETE) and (SelectedObjects <> nil) and RenderPanel.Focused() then
DeleteSelectedObjects();
// Снять выделение:
if OpenedMap = '' then
Exit;
- if Application.MessageBox(PChar(MsgMsgReopenMapPromt),
+ if Application.MessageBox(PChar(MsgMsgReopenMapPrompt),
PChar(MsgMenuFileReopen), MB_ICONQUESTION or MB_YESNO) <> idYes then
Exit;
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
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;
UNDO_DELETE_PANEL:
begin
AddPanel(Panel^);
- Panel := nil;
+ Dispose(Panel);
end;
UNDO_DELETE_ITEM: AddItem(Item);
UNDO_DELETE_AREA: AddArea(Area);
end;
SetLength(UndoBuffer, Length(UndoBuffer)-1);
-
RemoveSelectFromObjects();
-
miUndo.Enabled := UndoBuffer <> nil;
end;
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
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);
g_ProcessResourceStr(OpenedMap, FileName, Section, Res);
- SaveMap(FileName+':\'+Res);
+ SaveMap(FileName+':\'+Res, '');
end;
procedure TMainForm.aOpenMapExecute(Sender: TObject);
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('');
- g_DeleteResource(FileName, '', MapName, res);
- if res <> 0 then
+ 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]));
+
+ 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)));
- Application.MessageBox(
- PChar(Format(MsgMsgMapDeletedPromt, [MapName])),
- PChar(MsgMsgMapDeleted),
- MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1
- );
+ 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
+ );
+
+ 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;
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);
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;
newWad := newWad + '.wad'
end;
tempMap := newWAD + ':\' + TEST_MAP_NAME;
- SaveMap(tempMap);
+ SaveMap(tempMap, '');
// Опции игры:
opt := 32 + 64;