X-Git-Url: https://deadsoftware.ru/gitweb?p=d2df-editor.git;a=blobdiff_plain;f=src%2Feditor%2Ff_main.pas;h=8bdab7d638cc7c829574a91ebb9c7a3bc960a1cd;hp=9167af7bd3a34d88085e7006fc671d0d9ac12ec7;hb=b5f9c55a34f89cc238eedc5f0c2620a2d8ba6687;hpb=c3be56f2a3849cd22be39ce594498c7990e05606 diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index 9167af7..8bdab7d 100644 --- a/src/editor/f_main.pas +++ b/src/editor/f_main.pas @@ -1,6 +1,6 @@ unit f_main; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface @@ -8,7 +8,7 @@ uses LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ImgList, StdCtrls, Buttons, ComCtrls, ValEdit, Types, ToolWin, Menus, ExtCtrls, - CheckLst, Grids, OpenGLContext; + CheckLst, Grids, OpenGLContext, utils, UTF8Process; type @@ -207,6 +207,8 @@ type procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormResize(Sender: TObject); procedure lbTextureListClick(Sender: TObject); + procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); procedure RenderPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure RenderPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure RenderPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -258,8 +260,6 @@ type procedure OnIdle(Sender: TObject; var Done: Boolean); public procedure RefreshRecentMenu(); - { procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer; - Rect: TRect; State: TOwnerDrawState); } end; const @@ -1461,7 +1461,13 @@ begin MaxLength := 3; end; - with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_ALLMAP], BoolNames[Data.ShotAllMap], True)] do + case Data.ShotAim of + 1: str := _lc[I_PROP_TR_SHOT_AIM_1]; + 2: str := _lc[I_PROP_TR_SHOT_AIM_2]; + 3: str := _lc[I_PROP_TR_SHOT_AIM_3]; + else str := _lc[I_PROP_TR_SHOT_AIM_0]; + end; + with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_AIM], str, True)-1] do begin EditStyle := esPickList; ReadOnly := True; @@ -1789,6 +1795,7 @@ procedure FullClear(); begin RemoveSelectFromObjects(); ClearMap(); + LoadSky(gMapInfo.SkyName); UndoBuffer := nil; slInvalidTextures.Clear(); MapCheckForm.lbErrorList.Clear(); @@ -1874,6 +1881,7 @@ var ok: Boolean; FileName: String; ResourceName: String; + UResourceName: String; FullResourceName: String; SectionName: String; Data: Pointer; @@ -1900,19 +1908,20 @@ begin end else begin // Внешний WAD - FileName := EditorDir+'wads\'+aWAD; - ResourceName := aWAD+':'+SectionName+'\'+aTex; + FileName := EditorDir+'wads/'+aWAD; + ResourceName := utf2win(aWAD)+':'+SectionName+'\'+aTex; end; ok := True; + UResourceName := win2utf(ResourceName); // Есть ли уже такая текстура: for a := 0 to MainForm.lbTextureList.Items.Count-1 do - if ResourceName = MainForm.lbTextureList.Items[a] then + if UResourceName = MainForm.lbTextureList.Items[a] then begin if not silent then ErrorMessageBox(Format(_lc[I_MSG_TEXTURE_ALREADY], - [ResourceName])); + [UResourceName])); ok := False; end; @@ -1921,7 +1930,7 @@ begin begin if not silent then ErrorMessageBox(Format(_lc[I_MSG_RES_NAME_64], - [ResourceName])); + [UResourceName])); ok := False; end; @@ -1930,7 +1939,7 @@ begin a := -1; if aWAD = _lc[I_WAD_SPECIAL_TEXS] then begin - a := MainForm.lbTextureList.Items.Add(ResourceName); + a := MainForm.lbTextureList.Items.Add(UResourceName); if not silent then SelectTexture(a); Result := True; @@ -1944,12 +1953,12 @@ begin GetFrame(FullResourceName, Data, FrameLen, Width, Height); if g_CreateTextureMemorySize(Data, FrameLen, ResourceName, 0, 0, Width, Height, 1) then - a := MainForm.lbTextureList.Items.Add(ResourceName); + a := MainForm.lbTextureList.Items.Add(UResourceName); end else // Обычная текстура begin if g_CreateTextureWAD(ResourceName, FullResourceName) then - a := MainForm.lbTextureList.Items.Add(ResourceName); + a := MainForm.lbTextureList.Items.Add(UResourceName); end; if (a > -1) and (not silent) then SelectTexture(a); @@ -2038,7 +2047,7 @@ begin lbTextureList.Sorted := True; lbTextureList.Sorted := False; - UpdateCaption(gMapInfo.Name, ExtractFileName(FileName), MapName); + UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(FileName), MapName); end; end; @@ -2204,7 +2213,7 @@ end; function SelectedTexture(): String; begin if MainForm.lbTextureList.ItemIndex <> -1 then - Result := MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex] + Result := utf2win(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]) else Result := ''; end; @@ -2212,7 +2221,7 @@ end; function IsSpecialTextureSel(): Boolean; begin Result := (MainForm.lbTextureList.ItemIndex <> -1) and - IsSpecialTexture(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]); + IsSpecialTexture(utf2win(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex])); end; function CopyBufferToString(var CopyBuf: TCopyRecArray): String; @@ -2534,13 +2543,13 @@ begin cfglen := 0; wad := TWADEditor_1.Create; - if wad.ReadFile(EditorDir+'data\Game.wad') then + if wad.ReadFile(EditorDir+'data/Game.wad') then wad.GetResource('FONTS', cfgres, cfgdata, cfglen); wad.Free(); if cfglen <> 0 then begin - if not g_CreateTextureWAD('FONT_STD', EditorDir+'data\Game.wad:FONTS\'+texture) then + if not g_CreateTextureWAD('FONT_STD', EditorDir+'data/Game.wad:FONTS\'+texture) then e_WriteLog('ERROR ERROR ERROR', MSG_WARNING); config := TConfig.CreateMem(cfgdata, cfglen); @@ -2589,8 +2598,16 @@ begin OpenedMap := ''; OpenedWAD := ''; - config := TConfig.CreateFile(EditorDir+'\Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); + if config.ReadInt('Editor', 'XPos', -1) = -1 then + Position := poDesktopCenter + else begin + Left := config.ReadInt('Editor', 'XPos', Left); + Top := config.ReadInt('Editor', 'YPos', Top); + Width := config.ReadInt('Editor', 'Width', Width); + Height := config.ReadInt('Editor', 'Height', Height); + end; if config.ReadBool('Editor', 'Maximize', False) then WindowState := wsMaximized; ShowMap := config.ReadBool('Editor', 'Minimap', False); @@ -2674,7 +2691,7 @@ procedure TMainForm.Draw(); var x, y: Integer; a, b: Integer; - ID: DWORD; + ID, PID: DWORD; Width, Height: Word; Rect: TRectWH; ObjCount: Word; @@ -2746,10 +2763,9 @@ begin if not g_GetTexture(SelectedTexture(), ID) then g_GetTexture('NOTEXTURE', ID); g_GetTextureSizeByID(ID, Width, Height); - e_DrawFillQuad(RenderPanel.Width-Width-2, RenderPanel.Height-Height-2, - RenderPanel.Width-1, RenderPanel.Height-1, - GetRValue(PreviewColor), GetGValue(PreviewColor), GetBValue(PreviewColor), 0); - e_Draw(ID, RenderPanel.Width-Width-1, RenderPanel.Height-Height-1, 0, True, False); + if g_GetTexture('PREVIEW', PID) then + e_DrawFill(PID, RenderPanel.Width-Width, RenderPanel.Height-Height, Width div 16 + 1, Height div 16 + 1, 0, True, False); + e_Draw(ID, RenderPanel.Width-Width, RenderPanel.Height-Height, 0, True, False); end; // Подсказка при выборе точки Телепорта: @@ -3735,7 +3751,7 @@ begin trigger.Data.ShotPanelID := -1; trigger.Data.ShotTarget := 0; trigger.Data.ShotIntSight := 0; - trigger.Data.ShotAllMap := False; + trigger.Data.ShotAim := TRIGGER_SHOT_AIM_DEFAULT; trigger.Data.ShotPos.X := trigger.X-64; trigger.Data.ShotPos.Y := trigger.Y-64; trigger.Data.ShotAngle := 0; @@ -4015,8 +4031,22 @@ var config: TConfig; i: Integer; begin - config := TConfig.CreateFile(EditorDir+'\Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); + if WindowState <> wsMaximized then + begin + config.WriteInt('Editor', 'XPos', Left); + config.WriteInt('Editor', 'YPos', Top); + config.WriteInt('Editor', 'Width', Width); + config.WriteInt('Editor', 'Height', Height); + end + else + begin + config.WriteInt('Editor', 'XPos', RestoredLeft); + config.WriteInt('Editor', 'YPos', RestoredTop); + config.WriteInt('Editor', 'Width', RestoredWidth); + config.WriteInt('Editor', 'Height', RestoredHeight); + end; config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized); config.WriteBool('Editor', 'Minimap', ShowMap); config.WriteInt('Editor', 'PanelProps', PanelProps.ClientWidth); @@ -4038,7 +4068,7 @@ begin config.WriteStr('RecentFiles', IntToStr(i+1), ''); RecentFiles.Free(); - config.SaveFile(EditorDir+'\Editor.cfg'); + config.SaveFile(EditorDir+'Editor.cfg'); config.Free(); slInvalidTextures.Free; @@ -4060,7 +4090,7 @@ begin while (Pos(':\', ResName) > 0) do Delete(ResName, 1, Pos(':\', ResName) + 1); - UpdateCaption(gMapInfo.Name, ExtractFileName(OpenedWAD), ResName); + UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(OpenedWAD), ResName); end; procedure TMainForm.aAboutExecute(Sender: TObject); @@ -4281,11 +4311,11 @@ begin begin AddSoundForm.OKFunction := nil; AddSoundForm.lbResourcesList.MultiSelect := False; - AddSoundForm.SetResource := vleObjectProperty.Cells[1, i]; + AddSoundForm.SetResource := utf2win(vleObjectProperty.Cells[1, i]); if (AddSoundForm.ShowModal() = mrOk) then begin - vleObjectProperty.Cells[1, i] := AddSoundForm.ResourceName; + vleObjectProperty.Cells[1, i] := win2utf(AddSoundForm.ResourceName); bApplyProperty.Click(); end; Exit; @@ -4347,6 +4377,27 @@ begin end; end; +procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); +begin + with Control as TListBox do + begin + if LCLType.odSelected in State then + begin + Canvas.Brush.Color := clHighlight; + Canvas.Font.Color := clHighlightText; + end else + if (Items <> nil) and (Index >= 0) then + if slInvalidTextures.IndexOf(Items[Index]) > -1 then + begin + Canvas.Brush.Color := clRed; + Canvas.Font.Color := clWhite; + end; + Canvas.FillRect(ARect); + Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]); + end; +end; + procedure TMainForm.vleObjectPropertyGetPickList(Sender: TObject; const KeyName: String; Values: TStrings); begin @@ -4416,6 +4467,13 @@ begin Values.Add(_lc[I_PROP_TR_SHOT_TO_5]); Values.Add(_lc[I_PROP_TR_SHOT_TO_6]); end + else if KeyName = _lc[I_PROP_TR_SHOT_AIM] then + begin + Values.Add(_lc[I_PROP_TR_SHOT_AIM_0]); + Values.Add(_lc[I_PROP_TR_SHOT_AIM_1]); + 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_PANEL_BLEND]) or (KeyName = _lc[I_PROP_DM_ONLY]) or (KeyName = _lc[I_PROP_ITEM_FALLS]) or @@ -4433,7 +4491,6 @@ begin (KeyName = _lc[I_PROP_TR_SCORE_CON]) or (KeyName = _lc[I_PROP_TR_SCORE_MSG]) or (KeyName = _lc[I_PROP_TR_HEALTH_MAX]) or - (KeyName = _lc[I_PROP_TR_SHOT_ALLMAP]) or (KeyName = _lc[I_PROP_TR_SHOT_SOUND]) or (KeyName = _lc[I_PROP_TR_EFFECT_CENTER]) then begin @@ -4847,7 +4904,13 @@ begin Data.ShotTarget := 6; Data.ShotIntSight := Min(Max( StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_SIGHT]], 0), 0), 65535); - Data.ShotAllMap := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_ALLMAP]]); + Data.ShotAim := 0; + if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_AIM]] = _lc[I_PROP_TR_SHOT_AIM_1] then + Data.ShotAim := 1 + else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_AIM]] = _lc[I_PROP_TR_SHOT_AIM_2] then + Data.ShotAim := 2 + else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_AIM]] = _lc[I_PROP_TR_SHOT_AIM_3] then + Data.ShotAim := 3; Data.ShotAngle := Min( StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_ANGLE]], 0), 360); Data.ShotWait := Min(Max( @@ -5264,8 +5327,8 @@ begin begin Panel^.TextureID := SpecialTextureID(Panel^.TextureName); with MainForm.lbTextureList.Items do - if IndexOf(Panel^.TextureName) = -1 then - Add(Panel^.TextureName); + if IndexOf(win2utf(Panel^.TextureName)) = -1 then + Add(win2utf(Panel^.TextureName)); end; end; @@ -5426,11 +5489,11 @@ begin begin // Выбор файла звука/музыки: AddSoundForm.OKFunction := nil; AddSoundForm.lbResourcesList.MultiSelect := False; - AddSoundForm.SetResource := vleObjectProperty.Values[Key]; + AddSoundForm.SetResource := utf2win(vleObjectProperty.Values[Key]); if (AddSoundForm.ShowModal() = mrOk) then begin - vleObjectProperty.Values[Key] := AddSoundForm.ResourceName; + vleObjectProperty.Values[Key] := utf2win(AddSoundForm.ResourceName); bApplyProperty.Click(); end; end @@ -5539,6 +5602,8 @@ begin lbTypeSelect.Items.Add(ItemToStr(ITEM_HELMET)); lbTypeSelect.Items.Add(ItemToStr(ITEM_JETPACK)); lbTypeSelect.Items.Add(ItemToStr(ITEM_INVIS)); + lbTypeSelect.Items.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER)); + lbTypeSelect.Items.Add(ItemToStr(ITEM_AMMO_FUELCAN)); b := StrToItem(Values[Key]); if b >= ITEM_BOTTLE then @@ -5732,9 +5797,9 @@ begin else gLanguage := LANGUAGE_RUSSIAN; end; - config := TConfig.CreateFile(EditorDir+'\Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); config.WriteStr('Editor', 'Language', gLanguage); - config.SaveFile(EditorDir+'\Editor.cfg'); + config.SaveFile(EditorDir+'Editor.cfg'); config.Free(); end; @@ -5985,7 +6050,7 @@ begin gMapInfo.FileName := SaveDialog.FileName; gMapInfo.MapName := SaveMapForm.eMapName.Text; - UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName); + UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(gMapInfo.FileName), gMapInfo.MapName); end; procedure TMainForm.aSelectAllExecute(Sender: TObject); @@ -6038,7 +6103,9 @@ begin 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; @@ -6072,6 +6139,8 @@ begin PreviewMode := not PreviewMode; (Sender as TMenuItem).Checked := PreviewMode; + + FormResize(Self); end; procedure TMainForm.miLayer1Click(Sender: TObject); @@ -6204,21 +6273,33 @@ end; procedure TMainForm.miTestMapClick(Sender: TObject); var - cmd, mapWAD, mapToRun: String; + cmd, mapWAD, mapToRun, tempWAD: String; opt: LongWord; time: Integer; - lpMsgBuf: PChar; + 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; // Сохраняем временную карту: time := 0; repeat - mapWAD := ExtractFilePath(TestD2dExe) + Format('maps\temp%.4d.wad', [time]); + mapWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d.wad', [time]); Inc(time); until not FileExists(mapWAD); - mapToRun := mapWAD + ':\' + TEST_MAP_NAME; - SaveMap(mapToRun); + tempWAD := mapWAD + ':\' + TEST_MAP_NAME; + SaveMap(tempWAD); - mapToRun := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps\', mapToRun); + tempWAD := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', tempWAD); +// Если карта не была открыта, указываем временную в качестве текущей: + if mapToRun = '' then + mapToRun := tempWAD; // Опции игры: opt := 32 + 64; @@ -6234,7 +6315,8 @@ begin opt := opt + 16; // Составляем командную строку: - cmd := ' -map "' + mapToRun + '"'; + cmd := '-map "' + mapToRun + '"'; + cmd := cmd + ' -testmap "' + tempWAD + '"'; cmd := cmd + ' -gm ' + TestGameMode; cmd := cmd + ' -limt ' + TestLimTime; cmd := cmd + ' -lims ' + TestLimScore; @@ -6244,16 +6326,29 @@ begin cmd := cmd + ' --close'; cmd := cmd + ' --debug'; - cmd := cmd + ' --tempdelete'; // Запускаем: - Application.Minimize(); - if ExecuteProcess(TestD2dExe, cmd) < 0 then + proc := TProcessUTF8.Create(nil); + proc.Executable := TestD2dExe; + proc.Parameters.Add(cmd); + res := True; + try + proc.Execute(); + except + res := False; + end; + if res then + begin + Application.Minimize(); + proc.WaitOnExit(); + end; + if (not res) or (proc.ExitCode < 0) then begin MessageBox(0, 'FIXME', PChar(_lc[I_MSG_EXEC_ERROR]), MB_OK or MB_ICONERROR); end; + proc.Free(); SysUtils.DeleteFile(mapWAD); Application.Restore(); @@ -6348,26 +6443,4 @@ begin end; end; -{ -procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer; - Rect: TRect; State: LCLType.TOwnerDrawState); -begin - with Control as TListBox do - begin - if LCLType.odSelected in State then - begin - Canvas.Brush.Color := clHighlight; - Canvas.Font.Color := clHighlightText; - end else - if (Items <> nil) and (Index >= 0) then - if slInvalidTextures.IndexOf(Items[Index]) > -1 then - begin - Canvas.Brush.Color := clRed; - Canvas.Font.Color := clWhite; - end; - Canvas.FillRect(Rect); - Canvas.TextRect(Rect, Rect.Left, Rect.Top, Items[Index]); - end; -end; -} end.