From: Ketmar Dark Date: Fri, 18 Aug 2017 23:04:26 +0000 (+0300) Subject: changed mode from DELPHI to OBJFPC (with heavy customization, see "shared/a_modes... X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=9d2405d500b579d36f6e2330762a6cd51fbce581;p=d2df-sdl.git changed mode from DELPHI to OBJFPC (with heavy customization, see "shared/a_modes.inc") --- diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas index 51d6cc3..3ce6890 100644 --- a/src/engine/e_graphics.pas +++ b/src/engine/e_graphics.pas @@ -19,7 +19,7 @@ unit e_graphics; interface uses - SysUtils, Classes, Math, e_log, e_textures, SDL2, GL, GLExt, MAPDEF, ImagingTypes, Imaging, ImagingUtility; + SysUtils, Classes, Math, e_log, e_texture, SDL2, GL, GLExt, MAPDEF, ImagingTypes, Imaging, ImagingUtility; type TMirrorType=(M_NONE, M_HORIZONTAL, M_VERTICAL); diff --git a/src/engine/e_textures.pas b/src/engine/e_texture.pas similarity index 99% rename from src/engine/e_textures.pas rename to src/engine/e_texture.pas index dd2a535..6c348ba 100644 --- a/src/engine/e_textures.pas +++ b/src/engine/e_texture.pas @@ -14,7 +14,7 @@ * along with this program. If not, see . *) {$INCLUDE ../shared/a_modes.inc} -unit e_textures; +unit e_texture; { This unit provides interface to load 24-bit and 32-bit uncompressed images from Truevision Targa (TGA) graphic files, and create OpenGL textures diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 4123df2..72e2c3b 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -51,7 +51,7 @@ uses e_input in '../engine/e_input.pas', e_log in '../engine/e_log.pas', e_sound in '../engine/e_sound.pas', - e_textures in '../engine/e_textures.pas', + e_texture in '../engine/e_texture.pas', e_fixedbuffer in '../engine/e_fixedbuffer.pas', utils in '../shared/utils.pas', xstreams in '../shared/xstreams.pas', diff --git a/src/game/g_gui.pas b/src/game/g_gui.pas index eb06810..5c60e10 100644 --- a/src/game/g_gui.pas +++ b/src/game/g_gui.pas @@ -177,7 +177,7 @@ type public Proc: procedure; ProcEx: procedure (sender: TGUITextButton); - constructor Create(Proc: Pointer; FontID: DWORD; Text: string); + constructor Create(aProc: Pointer; FontID: DWORD; Text: string); destructor Destroy(); override; procedure OnMessage(var Msg: TMessage); override; procedure Update(); override; @@ -474,8 +474,8 @@ type destructor Destroy; override; procedure OnMessage(var Msg: TMessage); override; function AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton; - function GetButton(Name: string): TGUITextButton; - procedure EnableButton(Name: string; e: Boolean); + function GetButton(aName: string): TGUITextButton; + procedure EnableButton(aName: string; e: Boolean); procedure AddSpace(); procedure Update; override; procedure Draw; override; @@ -519,8 +519,8 @@ type function AddFileList(fText: string; Width, Height: Word): TGUIFileListBox; function AddMemo(fText: string; Width, Height: Word): TGUIMemo; procedure ReAlign(); - function GetControl(Name: string): TGUIControl; - function GetControlsText(Name: string): TGUILabel; + function GetControl(aName: string): TGUIControl; + function GetControlsText(aName: string): TGUILabel; procedure Draw; override; procedure Update; override; procedure UpdateIndex(); @@ -907,11 +907,11 @@ begin if FShowWindow <> '' then g_GUI_ShowWindow(FShowWindow); end; -constructor TGUITextButton.Create(Proc: Pointer; FontID: DWORD; Text: string); +constructor TGUITextButton.Create(aProc: Pointer; FontID: DWORD; Text: string); begin inherited Create(); - Self.Proc := Proc; + Self.Proc := aProc; ProcEx := nil; FFont := TFont.Create(FontID, FONT_CHAR); @@ -1113,14 +1113,14 @@ begin end; end; -procedure TGUIMainMenu.EnableButton(Name: string; e: Boolean); +procedure TGUIMainMenu.EnableButton(aName: string; e: Boolean); var a: Integer; begin if FButtons = nil then Exit; for a := 0 to High(FButtons) do - if (FButtons[a] <> nil) and (FButtons[a].Name = Name) then + if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then begin if e then FButtons[a].FColor := MAINMENU_ITEMS_COLOR else FButtons[a].FColor := MAINMENU_UNACTIVEITEMS_COLOR; @@ -1129,7 +1129,7 @@ begin end; end; -function TGUIMainMenu.GetButton(Name: string): TGUITextButton; +function TGUIMainMenu.GetButton(aName: string): TGUITextButton; var a: Integer; begin @@ -1138,7 +1138,7 @@ begin if FButtons = nil then Exit; for a := 0 to High(FButtons) do - if (FButtons[a] <> nil) and (FButtons[a].Name = Name) then + if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then begin Result := FButtons[a]; Break; @@ -1401,7 +1401,7 @@ end; procedure TGUIMenu.Draw; var - a, x, y: Integer; + a, locx, locy: Integer; begin inherited; @@ -1416,32 +1416,32 @@ begin if (FIndex <> -1) and (FCounter > MENU_MARKERDELAY div 2) then begin - x := 0; - y := 0; + locx := 0; + locy := 0; if FItems[FIndex].Text <> nil then begin - x := FItems[FIndex].Text.FX; - y := FItems[FIndex].Text.FY; + locx := FItems[FIndex].Text.FX; + locy := FItems[FIndex].Text.FY; //HACK! if FItems[FIndex].Text.RightAlign then begin - x := x+FItems[FIndex].Text.FMaxWidth-FItems[FIndex].Text.GetWidth; + locx := locx+FItems[FIndex].Text.FMaxWidth-FItems[FIndex].Text.GetWidth; end; end else if FItems[FIndex].Control <> nil then begin - x := FItems[FIndex].Control.FX; - y := FItems[FIndex].Control.FY; + locx := FItems[FIndex].Control.FX; + locy := FItems[FIndex].Control.FY; end; - x := x-e_CharFont_GetMaxWidth(FFontID); + locx := locx-e_CharFont_GetMaxWidth(FFontID); - e_CharFont_PrintEx(FFontID, x, y, #16, _RGB(255, 0, 0)); + e_CharFont_PrintEx(FFontID, locx, locy, #16, _RGB(255, 0, 0)); end; end; -function TGUIMenu.GetControl(Name: String): TGUIControl; +function TGUIMenu.GetControl(aName: String): TGUIControl; var a: Integer; begin @@ -1450,16 +1450,16 @@ begin if FItems <> nil then for a := 0 to High(FItems) do if FItems[a].Control <> nil then - if LowerCase(FItems[a].Control.Name) = LowerCase(Name) then + if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then begin Result := FItems[a].Control; Break; end; - Assert(Result <> nil, 'GUI control "'+Name+'" not found!'); + Assert(Result <> nil, 'GUI control "'+aName+'" not found!'); end; -function TGUIMenu.GetControlsText(Name: String): TGUILabel; +function TGUIMenu.GetControlsText(aName: String): TGUILabel; var a: Integer; begin @@ -1468,13 +1468,13 @@ begin if FItems <> nil then for a := 0 to High(FItems) do if FItems[a].Control <> nil then - if LowerCase(FItems[a].Control.Name) = LowerCase(Name) then + if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then begin Result := FItems[a].Text; Break; end; - Assert(Result <> nil, 'GUI control''s text "'+Name+'" not found!'); + Assert(Result <> nil, 'GUI control''s text "'+aName+'" not found!'); end; function TGUIMenu.NewItem: Integer; diff --git a/src/game/g_menu.pas b/src/game/g_menu.pas index d8619f3..0905cdc 100644 --- a/src/game/g_menu.pas +++ b/src/game/g_menu.pas @@ -46,7 +46,7 @@ uses g_basic, g_console, g_sound, g_gfx, g_player, g_options, g_weapons, e_log, SysUtils, CONFIG, g_playermodel, DateUtils, MAPSTRUCT, wadreader, Math, g_saveload, - e_textures, GL, GLExt, g_language, + e_texture, GL, GLExt, g_language, g_net, g_netmsg, g_netmaster, g_items, e_input; diff --git a/src/game/g_monsters.pas b/src/game/g_monsters.pas index 5ad20cc..57e3ce9 100644 --- a/src/game/g_monsters.pas +++ b/src/game/g_monsters.pas @@ -105,7 +105,7 @@ type procedure BFGHit(); procedure Update(); procedure ClientUpdate(); - procedure ClientAttack(wx, wy, tx, ty: Integer); + procedure ClientAttack(wx, wy, atx, aty: Integer); procedure SetDeadAnim; procedure Draw(); procedure WakeUp(); @@ -3607,7 +3607,7 @@ _end: FAnim[FCurAnim, FDirection].Update(); end; -procedure TMonster.ClientAttack(wx, wy, tx, ty: Integer); +procedure TMonster.ClientAttack(wx, wy, atx, aty: Integer); begin case FMonsterType of MONSTER_ZOMBY: @@ -3633,21 +3633,21 @@ begin g_Player_CreateShell(wx, wy, 0, -2, SHELL_BULLET); end; MONSTER_IMP: - g_Weapon_ball1(wx, wy, tx, ty, FUID); + g_Weapon_ball1(wx, wy, atx, aty, FUID); MONSTER_CYBER: - g_Weapon_rocket(wx, wy, tx, ty, FUID); + g_Weapon_rocket(wx, wy, atx, aty, FUID); MONSTER_SKEL: - g_Weapon_revf(wx, wy, tx, ty, FUID, FTargetUID); + g_Weapon_revf(wx, wy, atx, aty, FUID, FTargetUID); MONSTER_BSP: - g_Weapon_aplasma(wx, wy, tx, ty, FUID); + g_Weapon_aplasma(wx, wy, atx, aty, FUID); MONSTER_ROBO: - g_Weapon_plasma(wx, wy, tx, ty, FUID); + g_Weapon_plasma(wx, wy, atx, aty, FUID); MONSTER_MANCUB: - g_Weapon_manfire(wx, wy, tx, ty, FUID); + g_Weapon_manfire(wx, wy, atx, aty, FUID); MONSTER_BARON, MONSTER_KNIGHT: - g_Weapon_ball7(wx, wy, tx, ty, FUID); + g_Weapon_ball7(wx, wy, atx, aty, FUID); MONSTER_CACO: - g_Weapon_ball2(wx, wy, tx, ty, FUID); + g_Weapon_ball2(wx, wy, atx, aty, FUID); end; end; diff --git a/src/game/g_options.pas b/src/game/g_options.pas index 9009078..e4dd887 100644 --- a/src/game/g_options.pas +++ b/src/game/g_options.pas @@ -134,7 +134,7 @@ implementation uses e_log, e_input, g_window, g_sound, g_gfx, g_player, Math, - g_map, g_net, g_netmaster, SysUtils, CONFIG, g_game, g_main, e_textures, + g_map, g_net, g_netmaster, SysUtils, CONFIG, g_game, g_main, e_texture, g_items, GL, GLExt, wadreader, e_graphics; procedure g_Options_SetDefault(); diff --git a/src/game/g_player.pas b/src/game/g_player.pas index b25ef0c..f4c54db 100644 --- a/src/game/g_player.pas +++ b/src/game/g_player.pas @@ -260,7 +260,7 @@ type procedure SetWeapon(W: Byte); function IsKeyPressed(K: Byte): Boolean; function GetKeys(): Byte; - function PickItem(ItemType: Byte; respawn: Boolean; var remove: Boolean): Boolean; virtual; + function PickItem(ItemType: Byte; arespawn: Boolean; var remove: Boolean): Boolean; virtual; function Collide(X, Y: Integer; Width, Height: Word): Boolean; overload; function Collide(Panel: TPanel): Boolean; overload; function Collide(X, Y: Integer): Boolean; overload; @@ -376,9 +376,9 @@ type function FullInStep(XInc, YInc: Integer): Boolean; //function NeedItem(Item: Byte): Byte; procedure SelectWeapon(Dist: Integer); - procedure SetAIFlag(fName, fValue: String20); - function GetAIFlag(fName: String20): String20; - procedure RemoveAIFlag(fName: String20); + procedure SetAIFlag(aName, fValue: String20); + function GetAIFlag(aName: String20): String20; + procedure RemoveAIFlag(aName: String20); function Healthy(): Byte; procedure UpdateMove(); procedure UpdateCombat(); @@ -1835,13 +1835,13 @@ end; procedure TPlayer.ChangeModel(ModelName: string); var - Model: TPlayerModel; + locModel: TPlayerModel; begin - Model := g_PlayerModel_Get(ModelName); - if Model = nil then Exit; + locModel := g_PlayerModel_Get(ModelName); + if locModel = nil then Exit; FModel.Free(); - FModel := Model; + FModel := locModel; end; procedure TPlayer.SetModel(ModelName: string); @@ -2640,7 +2640,7 @@ procedure TPlayer.Fire(); var f, DidFire: Boolean; wx, wy, xd, yd: Integer; - obj: TObj; + locobj: TObj; begin if g_Game_IsClient then Exit; // FBFGFireCounter - âðåìÿ ïåðåä âûñòðåëîì (äëÿ BFG) @@ -2668,18 +2668,18 @@ begin if R_BERSERK in FRulez then begin //g_Weapon_punch(FObj.X+FObj.Rect.X, FObj.Y+FObj.Rect.Y, 75, FUID); - obj.X := FObj.X+FObj.Rect.X; - obj.Y := FObj.Y+FObj.Rect.Y; - obj.rect.X := 0; - obj.rect.Y := 0; - obj.rect.Width := 39; - obj.rect.Height := 52; - obj.Vel.X := (xd-wx) div 2; - obj.Vel.Y := (yd-wy) div 2; - obj.Accel.X := xd-wx; - obj.Accel.y := yd-wy; - - if g_Weapon_Hit(@obj, 50, FUID, HIT_SOME) <> 0 then + locobj.X := FObj.X+FObj.Rect.X; + locobj.Y := FObj.Y+FObj.Rect.Y; + locobj.rect.X := 0; + locobj.rect.Y := 0; + locobj.rect.Width := 39; + locobj.rect.Height := 52; + locobj.Vel.X := (xd-wx) div 2; + locobj.Vel.Y := (yd-wy) div 2; + locobj.Accel.X := xd-wx; + locobj.Accel.y := yd-wy; + + if g_Weapon_Hit(@locobj, 50, FUID, HIT_SOME) <> 0 then g_Sound_PlayExAt('SOUND_WEAPON_HITBERSERK', FObj.X, FObj.Y) else g_Sound_PlayExAt('SOUND_WEAPON_MISSBERSERK', FObj.X, FObj.Y); @@ -3505,7 +3505,7 @@ begin resetWeaponQueue(); end; -function TPlayer.PickItem(ItemType: Byte; respawn: Boolean; var remove: Boolean): Boolean; +function TPlayer.PickItem(ItemType: Byte; arespawn: Boolean; var remove: Boolean): Boolean; var a: Boolean; begin @@ -3513,7 +3513,7 @@ begin if g_Game_IsClient then Exit; // a = true - ìåñòî ñïàâíà ïðåäìåòà: - a := LongBool(gGameSettings.Options and GAME_OPTION_WEAPONSTAY) and respawn; + a := LongBool(gGameSettings.Options and GAME_OPTION_WEAPONSTAY) and arespawn; remove := not a; case ItemType of @@ -3579,7 +3579,7 @@ begin end; ITEM_WEAPON_SAW: - if (not FWeapon[WEAPON_SAW]) or ((not respawn) and (gGameSettings.GameMode in [GM_DM, GM_TDM, GM_CTF])) then + if (not FWeapon[WEAPON_SAW]) or ((not arespawn) and (gGameSettings.GameMode in [GM_DM, GM_TDM, GM_CTF])) then begin FWeapon[WEAPON_SAW] := True; Result := True; @@ -5042,7 +5042,7 @@ end; procedure TPlayer.NetFire(Wpn: Byte; X, Y, AX, AY: Integer; WID: Integer = -1); var - Obj: TObj; + locObj: TObj; F: Boolean; WX, WY, XD, YD: Integer; begin @@ -5058,18 +5058,18 @@ begin if R_BERSERK in FRulez then begin //g_Weapon_punch(FObj.X+FObj.Rect.X, FObj.Y+FObj.Rect.Y, 75, FUID); - obj.X := FObj.X+FObj.Rect.X; - obj.Y := FObj.Y+FObj.Rect.Y; - obj.rect.X := 0; - obj.rect.Y := 0; - obj.rect.Width := 39; - obj.rect.Height := 52; - obj.Vel.X := (xd-wx) div 2; - obj.Vel.Y := (yd-wy) div 2; - obj.Accel.X := xd-wx; - obj.Accel.y := yd-wy; - - if g_Weapon_Hit(@obj, 50, FUID, HIT_SOME) <> 0 then + locobj.X := FObj.X+FObj.Rect.X; + locobj.Y := FObj.Y+FObj.Rect.Y; + locobj.rect.X := 0; + locobj.rect.Y := 0; + locobj.rect.Width := 39; + locobj.rect.Height := 52; + locobj.Vel.X := (xd-wx) div 2; + locobj.Vel.Y := (yd-wy) div 2; + locobj.Accel.X := xd-wx; + locobj.Accel.y := yd-wy; + + if g_Weapon_Hit(@locobj, 50, FUID, HIT_SOME) <> 0 then g_Sound_PlayExAt('SOUND_WEAPON_HITBERSERK', FObj.X, FObj.Y) else g_Sound_PlayExAt('SOUND_WEAPON_MISSBERSERK', FObj.X, FObj.Y); @@ -6759,33 +6759,33 @@ begin Result := FKeys[Key].Pressed; end; -function TBot.GetAIFlag(fName: String20): String20; +function TBot.GetAIFlag(aName: String20): String20; var a: Integer; begin Result := ''; - fName := LowerCase(fName); + aName := LowerCase(aName); if FAIFlags <> nil then for a := 0 to High(FAIFlags) do - if LowerCase(FAIFlags[a].Name) = fName then + if LowerCase(FAIFlags[a].Name) = aName then begin Result := FAIFlags[a].Value; Break; end; end; -procedure TBot.RemoveAIFlag(fName: String20); +procedure TBot.RemoveAIFlag(aName: String20); var a, b: Integer; begin if FAIFlags = nil then Exit; - fName := LowerCase(fName); + aName := LowerCase(aName); for a := 0 to High(FAIFlags) do - if LowerCase(FAIFlags[a].Name) = fName then + if LowerCase(FAIFlags[a].Name) = aName then begin if a <> High(FAIFlags) then for b := a to High(FAIFlags)-1 do @@ -6796,7 +6796,7 @@ begin end; end; -procedure TBot.SetAIFlag(fName, fValue: String20); +procedure TBot.SetAIFlag(aName, fValue: String20); var a: Integer; ok: Boolean; @@ -6804,11 +6804,11 @@ begin a := 0; ok := False; - fName := LowerCase(fName); + aName := LowerCase(aName); if FAIFlags <> nil then for a := 0 to High(FAIFlags) do - if LowerCase(FAIFlags[a].Name) = fName then + if LowerCase(FAIFlags[a].Name) = aName then begin ok := True; Break; @@ -6820,7 +6820,7 @@ begin SetLength(FAIFlags, Length(FAIFlags)+1); with FAIFlags[High(FAIFlags)] do begin - Name := fName; + Name := aName; Value := fValue; end; end; diff --git a/src/shared/a_modes.inc b/src/shared/a_modes.inc index 13c328e..277c6a7 100644 --- a/src/shared/a_modes.inc +++ b/src/shared/a_modes.inc @@ -1,10 +1,33 @@ // compiler options, common for all game modules -{$MODE DELPHI} +{.$MODE DELPHI} +{$MODE OBJFPC} {$MODESWITCH ADVANCEDRECORDS+} -{$MODESWITCH DUPLICATELOCALS-} +{$MODESWITCH ALLOWINLINE+} +{$MODESWITCH ANSISTRINGS+} // Allow use of ansistrings. +{$MODESWITCH AUTODEREF+} // Automatic (silent) dereferencing of typed pointers. +{$MODESWITCH CLASS+} +{$MODESWITCH CLASSICPROCVARS+} // Use classical procedural variables. +{$MODESWITCH DEFAULTPARAMETERS+} // Allow use of default parameter values. +{$MODESWITCH DUPLICATELOCALS-} // Allow local variables in class methods to have the same names as properties of the class. +{$MODESWITCH EXCEPTIONS+} +{$MODESWITCH HINTDIRECTIVE+} // Support the hint directives (deprecated, platform etc.) +{$MODESWITCH INITFINAL+} // Allow use of Initialization and Finalization +{.$MODESWITCH ISOUNARYMINUS-} // Unary minus as required by ISO pascal. +{$MODESWITCH MACPROCVARS-} // Use mac-style procedural variables. +{$MODESWITCH NESTEDCOMMENTS-} {$MODESWITCH NESTEDPROCVARS+} +{$MODESWITCH OBJPAS+} +{$MODESWITCH OUT+} // Allow use of the out parameter type. +{$MODESWITCH PCHARTOSTRING+} +{$MODESWITCH POINTERTOPROCVAR+} // Allow silent conversion of pointers to procedural variables. +{$MODESWITCH PROPERTIES+} +{$MODESWITCH REPEATFORWARD+} // Implementation and Forward declaration must match completely. +{$MODESWITCH RESULT+} +{$MODESWITCH TYPEHELPERS-} // Allow the use of type helpers. {$MODESWITCH UNICODESTRINGS-} +{$MODESWITCH UNICODESTRINGS-} + {$ASSERTIONS ON} {$BITPACKING OFF} diff --git a/src/shared/xprofiler.pas b/src/shared/xprofiler.pas index 51d99e8..e335e3f 100644 --- a/src/shared/xprofiler.pas +++ b/src/shared/xprofiler.pas @@ -135,11 +135,11 @@ type // call this on frame end procedure mainEnd (); - procedure sectionBegin (name: AnsiString); + procedure sectionBegin (aName: AnsiString); procedure sectionEnd (); // this will reuse the section with the given name (if there is any); use `sectionEnd()` to end it as usual - procedure sectionBeginAccum (name: AnsiString); + procedure sectionBeginAccum (aName: AnsiString); end; @@ -417,7 +417,7 @@ begin {$ENDIF} end; -procedure TProfiler.sectionBegin (name: AnsiString); +procedure TProfiler.sectionBegin (aName: AnsiString); {$IF DEFINED(STOPWATCH_IS_HERE)} var sid: Integer; @@ -431,7 +431,7 @@ begin sid := xpsused; Inc(xpsused); pss := @xpsecs[sid]; - pss.name := name; + pss.name := aName; pss.timer.clear(); pss.prevAct := xpscur; // calculate level @@ -441,7 +441,7 @@ begin {$ENDIF} end; -procedure TProfiler.sectionBeginAccum (name: AnsiString); +procedure TProfiler.sectionBeginAccum (aName: AnsiString); {$IF DEFINED(STOPWATCH_IS_HERE)} var idx: Integer; @@ -453,10 +453,10 @@ begin begin for idx := 0 to xpsused-1 do begin - if (xpsecs[idx].name = name) then + if (xpsecs[idx].name = aName) then begin - if (idx = xpscur) then raise Exception.Create('profiler error(0): dobule resume: "'+name+'"'); - if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): dobule resume: "'+name+'"'); + if (idx = xpscur) then raise Exception.Create('profiler error(0): dobule resume: "'+aName+'"'); + if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): dobule resume: "'+aName+'"'); xpsecs[idx].prevAct := xpscur; xpscur := idx; xpsecs[idx].timer.resume(); @@ -464,7 +464,7 @@ begin end; end; end; - sectionBegin(name); + sectionBegin(aName); {$ENDIF} end;