├── DoomXS.ico ├── DoomXS.res ├── DoomXSL.ico ├── DoomXSL.res ├── .gitattributes ├── LaunchXS ├── main.ddp ├── LaunchXS.ico ├── LaunchXS.png ├── LaunchXS.res ├── LaunchXS.dpr ├── LaunchXS.dof └── main.pas ├── README.md ├── doomstat.pas ├── p_pspr_h.pas ├── r_sky.pas ├── d_think.pas ├── d_ticcmd.pas ├── .gitignore ├── m_bbox.pas ├── m_fixed.pas ├── m_argv.pas ├── i_io.pas ├── tables.pas ├── DXTypes.pas ├── DoomXS.dof ├── p_local.pas ├── i_main.pas ├── d_event.pas ├── m_rnd.pas ├── d_items.pas ├── m_cheat.pas ├── DoomXS.dpr ├── DoomXSL.lpr ├── p_tick.pas ├── p_telept.pas ├── doomdef.pas ├── f_wipe.pas ├── d_player.pas ├── doomdata.pas ├── p_mobj_h.pas ├── i_video.pas ├── i_midi.pas ├── r_intrpl.pas ├── i_net.pas ├── z_memory.pas ├── i_system.pas ├── p_ceilng.pas ├── i_input.pas ├── p_plats.pas ├── st_lib.pas ├── p_lights.pas ├── p_sight.pas └── r_plane.pas /DoomXS.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/DoomXS.ico -------------------------------------------------------------------------------- /DoomXS.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/DoomXS.res -------------------------------------------------------------------------------- /DoomXSL.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/DoomXSL.ico -------------------------------------------------------------------------------- /DoomXSL.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/DoomXSL.res -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /LaunchXS/main.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/LaunchXS/main.ddp -------------------------------------------------------------------------------- /LaunchXS/LaunchXS.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/LaunchXS/LaunchXS.ico -------------------------------------------------------------------------------- /LaunchXS/LaunchXS.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/LaunchXS/LaunchXS.png -------------------------------------------------------------------------------- /LaunchXS/LaunchXS.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/DoomXS/HEAD/LaunchXS/LaunchXS.res -------------------------------------------------------------------------------- /LaunchXS/LaunchXS.dpr: -------------------------------------------------------------------------------- 1 | program LaunchXS; 2 | 3 | uses 4 | Forms, 5 | main in 'main.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.Title := 'DoomXS Launcher'; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DoomXS 2 | Minimalistic source port of Doom developed in Pascal language. 3 | 4 | ## Features 5 | 640x400 display 6 | 7 | Raised static limits 8 | 9 | Support for DOOMWADDIR & DOOMWADPATH eviroment variables 10 | 11 | Uncapped framerate 12 | 13 | Low hardware requirements 14 | 15 | Launcher app 16 | 17 | ## Downloads 18 | 19 | [version 1.0.6.142 (20220410 - win32)](https://sourceforge.net/projects/doomxs/files/DoomXS_1.0/DoomXS_1.0.6.142_bin.zip/download) 20 | 21 | [version 1.0.5.138 (20211031 - win32)](https://sourceforge.net/projects/doomxs/files/DoomXS_1.0/DoomXS_1.0.5.138_bin.zip/download) 22 | 23 | [version 1.0.4.137 (20211004 - win32)](https://sourceforge.net/projects/doomxs/files/DoomXS_1.0/DoomXS_1.0.4.137_bin.zip/download) 24 | 25 | [version 1.0.3.136 (20211003 - win32)](https://sourceforge.net/projects/doomxs/files/DoomXS_1.0/DoomXS_1.0.3.136_bin.zip/download) 26 | 27 | [version 1.0.2.134 (20210930 - win32)](https://sourceforge.net/projects/doomxs/files/DoomXS_1.0/DoomXS_1.0.2.134_bin.zip/download) 28 | 29 | [version 1.0.1.133 (20210930 - win32)](https://sourceforge.net/projects/doomxs/files/DoomXS_1.0/DoomXS_1.0.1.133_bin.zip/download) 30 | 31 | ## Screenshots 32 | 33 | ![Screenshot 1](https://i.postimg.cc/4xn5wfFd/doomxs01.png "Screenshot 1") 34 | 35 | ![Screenshot 2](https://i.postimg.cc/5tdCvbhD/doomxs02.png "Screenshot 2") 36 | -------------------------------------------------------------------------------- /doomstat.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit doomstat; 28 | 29 | interface 30 | 31 | uses 32 | doomdef; 33 | 34 | var 35 | // Game Mode - identify IWAD as shareware, retail etc. 36 | gamemode: GameMode_t = indetermined; 37 | gamemission: GameMission_t = doom; 38 | 39 | // Language. 40 | language: Language_t = english; 41 | 42 | // Set if homebrew PWAD stuff has been added. 43 | modifiedgame: boolean = False; 44 | 45 | implementation 46 | 47 | end. 48 | -------------------------------------------------------------------------------- /p_pspr_h.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_pspr_h; 28 | 29 | interface 30 | 31 | uses 32 | m_fixed, 33 | info_h; 34 | 35 | type 36 | // Overlay psprites are scaled shapes 37 | // drawn directly on the view screen, 38 | // coordinates are given for a 320*200 view screen. 39 | psprnum_t = ( 40 | ps_weapon, 41 | ps_flash, 42 | NUMPSPRITES 43 | ); 44 | 45 | pspdef_t = record 46 | state: Pstate_t; // a NULL state means not active 47 | tics: integer; 48 | sx: fixed_t; 49 | sy: fixed_t; 50 | end; 51 | Ppspdef_t = ^pspdef_t; 52 | 53 | implementation 54 | 55 | end. 56 | -------------------------------------------------------------------------------- /r_sky.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit r_sky; 28 | 29 | interface 30 | 31 | // SKY, store the number for name. 32 | const 33 | SKYFLATNAME = 'F_SKY1'; 34 | 35 | // The sky map is 256*128*4 maps. 36 | ANGLETOSKYSHIFT = 22; 37 | 38 | var 39 | skyflatnum: integer; 40 | skytexture: integer; 41 | skytexturemid: integer; 42 | 43 | procedure R_InitSkyMap; 44 | 45 | implementation 46 | 47 | uses 48 | m_fixed; // Needed for FRACUNIT. 49 | 50 | // R_InitSkyMap 51 | // Called whenever the view size changes. 52 | procedure R_InitSkyMap; 53 | begin 54 | skytexturemid := 100 * FRACUNIT; 55 | end; 56 | 57 | end. 58 | -------------------------------------------------------------------------------- /d_think.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit d_think; 28 | 29 | interface 30 | 31 | type 32 | actionf_v = procedure; 33 | actionf_p1 = procedure(p1: pointer); 34 | actionf_p2 = procedure(p1, p2: pointer); 35 | 36 | actionf_t = record 37 | case integer of 38 | 0 : (acp1: actionf_p1); 39 | 1 : (acv: actionf_v); 40 | 2 : (acp2: actionf_p2); 41 | end; 42 | Pactionf_t = ^actionf_t; 43 | 44 | think_t = actionf_t; 45 | Pthink_t = ^think_t; 46 | 47 | Pthinker_t = ^thinker_t; 48 | thinker_t = record 49 | prev: Pthinker_t; 50 | next: Pthinker_t; 51 | func: think_t; 52 | end; 53 | 54 | implementation 55 | 56 | end. 57 | -------------------------------------------------------------------------------- /d_ticcmd.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit d_ticcmd; 28 | 29 | interface 30 | 31 | // The data sampled per tick (single player) 32 | // and transmitted to other peers (multiplayer). 33 | // Mainly movements/button commands per game tick, 34 | // plus a checksum for internal state consistency. 35 | type 36 | ticcmd_t = packed record 37 | forwardmove: shortint; // *2048 for move 38 | sidemove: shortint; // *2048 for move 39 | angleturn: smallint; // <<16 for angle delta 40 | consistency: smallint; // checks for net game 41 | chatchar: byte; 42 | buttons: byte; 43 | end; 44 | Pticcmd_t = ^ticcmd_t; 45 | 46 | implementation 47 | 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | 71 | backup/*.* 72 | lib/*.* 73 | lib/i386-win32/*.* 74 | *.~* 75 | *.dsk 76 | -------------------------------------------------------------------------------- /m_bbox.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit m_bbox; 28 | 29 | interface 30 | 31 | uses 32 | m_fixed; 33 | 34 | // Bounding box coordinate storage. 35 | const 36 | BOXTOP = 0; 37 | BOXBOTTOM = 1; 38 | BOXLEFT = 2; 39 | BOXRIGHT = 3; 40 | 41 | // Bounding box functions. 42 | procedure M_ClearBox(box: Pfixed_tArray); 43 | 44 | procedure M_AddToBox(box: Pfixed_tArray; x: fixed_t; y: fixed_t); 45 | 46 | implementation 47 | 48 | uses 49 | d_delphi; 50 | 51 | procedure M_ClearBox(box: Pfixed_tArray); 52 | begin 53 | box[BOXTOP] := MININT; 54 | box[BOXRIGHT] := MININT; 55 | box[BOXBOTTOM] := MAXINT; 56 | box[BOXLEFT] := MAXINT; 57 | end; 58 | 59 | procedure M_AddToBox(box: Pfixed_tArray; x: fixed_t; y: fixed_t); 60 | begin 61 | if x < box[BOXLEFT] then 62 | box[BOXLEFT] := x 63 | else if x > box[BOXRIGHT] then 64 | box[BOXRIGHT] := x; 65 | if y < box[BOXBOTTOM] then 66 | box[BOXBOTTOM] := y 67 | else if y > box[BOXTOP] then 68 | box[BOXTOP] := y; 69 | end; 70 | 71 | end. 72 | -------------------------------------------------------------------------------- /m_fixed.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit m_fixed; 28 | 29 | interface 30 | 31 | const 32 | FRACBITS = 16; 33 | FRACUNIT = 1 shl FRACBITS; 34 | 35 | type 36 | fixed_t = integer; 37 | Pfixed_t = ^fixed_t; 38 | fixed_tArray = packed array[0..$FFFF] of fixed_t; 39 | Pfixed_tArray = ^fixed_tArray; 40 | 41 | function FixedMul(const a, b: fixed_t): fixed_t; 42 | 43 | function FixedDiv(const a, b: fixed_t): fixed_t; 44 | 45 | implementation 46 | 47 | uses 48 | d_delphi; 49 | 50 | function FixedDiv2(const a, b: fixed_t): fixed_t; assembler; 51 | asm 52 | mov ebx, b 53 | mov edx, eax 54 | sal eax, 16 55 | sar edx, 16 56 | idiv ebx 57 | end; 58 | 59 | function FixedMul(const a, b: fixed_t): fixed_t; assembler; 60 | asm 61 | imul b 62 | shrd eax, edx, 16 63 | end; 64 | 65 | function FixedDiv(const a, b: fixed_t): fixed_t; 66 | begin 67 | if _SHR(abs(a), 14) >= abs(b) then 68 | begin 69 | if a xor b < 0 then 70 | Result := MININT 71 | else 72 | Result := MAXINT; 73 | end 74 | else 75 | Result := FixedDiv2(a, b); 76 | end; 77 | 78 | end. 79 | -------------------------------------------------------------------------------- /m_argv.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit m_argv; 28 | 29 | interface 30 | 31 | const 32 | MAXARGS = 256; 33 | 34 | var 35 | myargc: integer; 36 | myargv: array[0..MAXARGS] of string; 37 | 38 | { Returns the position of the given parameter } 39 | { in the arg list (0 if not found). } 40 | function M_CheckParm(const check: string): integer; 41 | 42 | function M_CheckParmCDROM: boolean; 43 | 44 | procedure M_InitArgv; 45 | 46 | implementation 47 | 48 | uses 49 | d_delphi; 50 | 51 | var 52 | cdchecked: integer = -1; 53 | 54 | function M_CheckParm(const check: string): integer; 55 | var 56 | i: integer; 57 | begin 58 | for i := 1 to myargc - 1 do 59 | if strupper(check) = myargv[i] then 60 | begin 61 | Result := i; 62 | Exit; 63 | end; 64 | Result := 0; 65 | end; 66 | 67 | function M_CheckParmCDROM: boolean; 68 | begin 69 | if cdchecked = -1 then 70 | begin 71 | cdchecked := M_CheckParm('-cdrom'); 72 | {$I-} 73 | if cdchecked > 0 then 74 | MkDir('c:\doomdata'); 75 | {$I+} 76 | end; 77 | Result := cdchecked > 0; 78 | end; 79 | 80 | procedure M_InitArgv; 81 | var 82 | i: integer; 83 | begin 84 | myargc := ParamCount + 1; 85 | for i := 0 to myargc - 1 do 86 | myargv[i] := strupper(ParamStr(i)); 87 | for i := myargc to MAXARGS do 88 | myargv[i] := ''; 89 | end; 90 | 91 | end. 92 | -------------------------------------------------------------------------------- /i_io.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit i_io; 28 | 29 | interface 30 | 31 | uses 32 | d_delphi; 33 | 34 | var 35 | debugfile: TFile; 36 | stderr: TFile; 37 | 38 | procedure I_InitializeIO; 39 | 40 | procedure I_ShutdownIO; 41 | 42 | procedure I_IOErrorMessageBox(const s: string); 43 | 44 | procedure I_IOprintf(const s: string); 45 | 46 | implementation 47 | 48 | uses 49 | Windows, 50 | g_game, 51 | i_main, 52 | m_argv; 53 | 54 | procedure I_IOErrorMessageBox(const s: string); 55 | begin 56 | MessageBox(hMainWnd, PChar(s), AppTitle, MB_OK or MB_ICONERROR); 57 | end; 58 | 59 | procedure I_IOprintf(const s: string); 60 | begin 61 | end; 62 | 63 | procedure I_InitializeIO; 64 | var 65 | filename: string; 66 | begin 67 | if M_CheckParm('-debugfile') <> 0 then 68 | sprintf(filename, 'debug%d.txt', [consoleplayer]) 69 | else 70 | filename := 'debug.txt'; 71 | 72 | if M_CheckParmCDROM then 73 | begin 74 | stderr := TFile.Create('c:\dooomdata\stderr.txt', fCreate); 75 | filename := 'c:\dooomdata\' + filename; 76 | end 77 | else 78 | stderr := TFile.Create('stderr.txt', fCreate); 79 | 80 | printf('debug output to: %s' + #13#10, [filename]); 81 | debugfile := TFile.Create(filename, fCreate); 82 | end; 83 | 84 | 85 | procedure I_ShutdownIO; 86 | begin 87 | stderr.Free; 88 | debugfile.Free; 89 | end; 90 | 91 | end. 92 | -------------------------------------------------------------------------------- /tables.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit tables; 28 | 29 | interface 30 | 31 | uses 32 | m_fixed; 33 | 34 | const 35 | d_PI = 3.141592657; 36 | 37 | const 38 | FINEANGLES = 8192; 39 | FINEMASK = FINEANGLES - 1; 40 | 41 | // 0x100000000 to 0x2000 42 | ANGLETOFINESHIFT = 19; 43 | 44 | type 45 | angle_t = LongWord; 46 | 47 | const 48 | ANG45 = $20000000; 49 | ANG90 = $40000000; 50 | ANG180 = $80000000; 51 | ANG270 = $c0000000; 52 | SLOPERANGE = 2048; 53 | SLOPEBITS = 11; 54 | DBITS = FRACBITS - SLOPEBITS; 55 | 56 | var 57 | // Effective size is 10240. 58 | finesine: array[0..((5 * FINEANGLES) div 4) - 1] of fixed_t; 59 | 60 | // Re-use data, is just PI/2 pahse shift. 61 | finecosine: Pfixed_tArray; 62 | 63 | // Effective size is 4096. 64 | finetangent : array[0..(FINEANGLES div 2) - 1] of fixed_t; 65 | 66 | // Effective size is 2049; 67 | // The +1 size is to handle the case when x==y 68 | // without additional checking. 69 | tantoangle: array[0..(SLOPERANGE + 1) - 1] of angle_t; 70 | 71 | // Utility function, 72 | // called by R_PointToAngle. 73 | function SlopeDiv(const num: integer; const den: integer): integer; 74 | 75 | implementation 76 | 77 | uses 78 | d_delphi; 79 | 80 | function SlopeDiv(const num: integer; const den: integer): integer; 81 | var 82 | ans: LongWord; 83 | begin 84 | if den < 512 then 85 | Result := SLOPERANGE 86 | else 87 | begin 88 | ans := _SHL(num, 3) div _SHR(den, 8); 89 | if ans < SLOPERANGE then 90 | Result := ans 91 | else 92 | Result := SLOPERANGE; 93 | end; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /DXTypes.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | {* *} 3 | {* Copyright (C) Microsoft Corporation. All Rights Reserved. *} 4 | {* *} 5 | {* File: extracted from various DirectX SDK include files *} 6 | {* *} 7 | {* Content: DirectX 9.0 headers common types *} 8 | {* *} 9 | {* Direct3DX 9.0 Delphi adaptation by Alexey Barkovoy *} 10 | {* E-Mail: clootie@reactor.ru *} 11 | {* *} 12 | {* Modified: 26-Jan-2003 *} 13 | {* *} 14 | {* Latest version can be downloaded from: *} 15 | {* http://clootie.narod.ru/delphi *} 16 | {* *} 17 | {******************************************************************************) 18 | { } 19 | { The contents of this file are subject to the Mozilla Public License Version } 20 | { 1.1 (the "License"); you may not use this file except in compliance with the } 21 | { License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ } 22 | { } 23 | { Software distributed under the License is distributed on an "AS IS" basis, } 24 | { WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for } 25 | { the specific language governing rights and limitations under the License. } 26 | { } 27 | { The Original Code is DXTypes.pas. } 28 | { } 29 | {******************************************************************************} 30 | unit DXTypes; 31 | 32 | interface 33 | 34 | uses Windows; 35 | 36 | type 37 | // TD3DValue is the fundamental Direct3D fractional data type 38 | D3DVALUE = Single; 39 | TD3DValue = D3DVALUE; 40 | PD3DValue = ^TD3DValue; 41 | {$NODEFINE D3DVALUE} 42 | {$NODEFINE TD3DValue} 43 | {$NODEFINE PD3DValue} 44 | 45 | D3DCOLOR = DWord; 46 | TD3DColor = D3DCOLOR; 47 | PD3DColor = ^TD3DColor; 48 | {$NODEFINE D3DCOLOR} 49 | {$NODEFINE TD3DColor} 50 | {$NODEFINE PD3DColor} 51 | 52 | _D3DVECTOR = packed record 53 | x: Single; 54 | y: Single; 55 | z: Single; 56 | end {_D3DVECTOR}; 57 | D3DVECTOR = _D3DVECTOR; 58 | TD3DVector = _D3DVECTOR; 59 | PD3DVector = ^TD3DVector; 60 | {$NODEFINE _D3DVECTOR} 61 | {$NODEFINE D3DVECTOR} 62 | {$NODEFINE TD3DVector} 63 | {$NODEFINE PD3DVector} 64 | 65 | implementation 66 | 67 | end. 68 | 69 | -------------------------------------------------------------------------------- /LaunchXS/LaunchXS.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=..\..\bin 94 | UnitOutputDir=..\..\dcu\LaunchXS 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=0 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=1032 125 | CodePage=1253 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=1.0.0.0 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [HistoryLists\hlUnitAliases] 138 | Count=1 139 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 140 | [HistoryLists\hlUnitOutputDirectory] 141 | Count=3 142 | Item0=..\..\dcu\LaunchXS 143 | Item1=..\..\dcu\SetupXS 144 | Item2=..\dcu 145 | [HistoryLists\hlOutputDirectorry] 146 | Count=2 147 | Item0=..\..\bin 148 | Item1=..\bin 149 | -------------------------------------------------------------------------------- /DoomXS.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=2 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=..\bin 94 | UnitOutputDir=..\dcu 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams=-iwad doom2.wad 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=1 114 | AutoIncBuild=1 115 | MajorVer=1 116 | MinorVer=0 117 | Release=6 118 | Build=142 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=1033 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName=Jim Valavanis 128 | FileDescription=DoomXS 129 | FileVersion=1.0.6.142 130 | InternalName=Doom 131 | LegalCopyright=Copyright (c) 2021-2022, Jim Valavanis 132 | LegalTrademarks=Copyright (c) 2021-2022, Jim Valavanis 133 | OriginalFilename=DoomXS.exe 134 | ProductName=Windows source port of Doom 135 | ProductVersion=1.0.0.0 136 | Comments=https://sourceforge.net/projects/doomxs/ 137 | [HistoryLists\hlUnitAliases] 138 | Count=1 139 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 140 | [HistoryLists\hlUnitOutputDirectory] 141 | Count=1 142 | Item0=..\dcu 143 | [HistoryLists\hlOutputDirectorry] 144 | Count=1 145 | Item0=..\bin 146 | -------------------------------------------------------------------------------- /p_local.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_local; 28 | 29 | interface 30 | 31 | uses 32 | d_delphi, 33 | m_fixed, 34 | p_mobj_h, 35 | r_defs; 36 | 37 | const 38 | TOCENTER = -8; 39 | 40 | FLOATSPEED = FRACUNIT * 4; 41 | 42 | MAXHEALTH = 100; 43 | // Player VIEWHEIGHT 44 | PVIEWHEIGHT = 41 * FRACUNIT; 45 | 46 | // mapblocks are used to check movement 47 | // against lines and things 48 | MAPBLOCKUNITS = 128; 49 | MAPBLOCKSIZE = MAPBLOCKUNITS * FRACUNIT; 50 | 51 | MAPBLOCKSHIFT = FRACBITS + 7; 52 | MAPBMASK = MAPBLOCKSIZE - 1; 53 | MAPBTOFRAC = MAPBLOCKSHIFT - FRACBITS; 54 | 55 | // player radius for movement checking 56 | PLAYERRADIUS = 16 * FRACUNIT; 57 | 58 | // MAXRADIUS is for precalculated sector block boxes 59 | // the spider demon is larger, 60 | // but we do not have any moving sectors nearby 61 | MAXRADIUS = 32 * FRACUNIT; 62 | 63 | GRAVITY = FRACUNIT; 64 | MAXMOVE = 30 * FRACUNIT; 65 | 66 | USERANGEINT = 64; 67 | MELEERANGE = 64 * FRACUNIT; 68 | MISSILERANGE = (32 * 64) * FRACUNIT; 69 | 70 | // follow a player exlusively for 3 seconds 71 | BASETHRESHOLD = 100; 72 | 73 | const 74 | ONFLOORZ = MININT; 75 | ONCEILINGZ = MAXINT; 76 | 77 | const 78 | // Time interval for item respawning. 79 | ITEMQUESIZE = 128; 80 | 81 | type 82 | divline_t = record 83 | x: fixed_t; 84 | y: fixed_t; 85 | dx: fixed_t; 86 | dy: fixed_t; 87 | end; 88 | Pdivline_t = ^divline_t; 89 | 90 | thingORline_t = record 91 | case integer of 92 | 0: (thing: Pmobj_t); 93 | 1: (line: Pline_t); 94 | end; 95 | 96 | intercept_t = record 97 | frac: fixed_t; // along trace line 98 | isaline: boolean; 99 | d: thingORline_t; 100 | end; 101 | Pintercept_t = ^intercept_t; 102 | 103 | const 104 | MAXINTERCEPTS = 128; 105 | 106 | type 107 | traverser_t = function(f: Pintercept_t): boolean; 108 | ltraverser_t = function(p: Pline_t): boolean; 109 | ttraverser_t = function(p: Pmobj_t): boolean; 110 | 111 | const 112 | PT_ADDLINES = 1; 113 | PT_ADDTHINGS = 2; 114 | PT_EARLYOUT = 4; 115 | 116 | implementation 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /i_main.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit i_main; 28 | 29 | interface 30 | 31 | uses 32 | Windows, 33 | d_delphi; 34 | 35 | var 36 | hMainWnd: HWND = 0; 37 | 38 | const 39 | AppTitle = 'DoomXS'; 40 | 41 | procedure DoomMain; 42 | 43 | implementation 44 | 45 | uses 46 | Messages, 47 | d_main, 48 | i_input, 49 | i_system; 50 | 51 | function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export; 52 | begin 53 | if not I_GameFinished then 54 | begin 55 | case Msg of 56 | WM_SETCURSOR: 57 | begin 58 | SetCursor(0); 59 | end; 60 | WM_SYSCOMMAND: 61 | begin 62 | if wParam = SC_SCREENSAVE then 63 | begin 64 | Result := 0; 65 | Exit; 66 | end; 67 | end; 68 | WM_ACTIVATE: 69 | begin 70 | I_SynchronizeInput(wparam <> WA_INACTIVE); 71 | end; 72 | WM_CLOSE: 73 | begin 74 | Result := 0; // Preserve closing window by pressing Alt + F4 75 | Exit; 76 | end; 77 | WM_DESTROY: 78 | begin 79 | I_Destroy; 80 | end; 81 | end; 82 | end; 83 | 84 | Result := DefWindowProc(hWnd, Msg, WParam, LParam); 85 | end; 86 | 87 | procedure DoomMain; 88 | var 89 | WindowClass: TWndClass; 90 | begin 91 | I_SetDPIAwareness; 92 | 93 | ZeroMemory(@WindowClass, SizeOf(WindowClass)); 94 | WindowClass.lpfnWndProc := @WindowProc; 95 | WindowClass.hbrBackground := GetStockObject(DKGRAY_BRUSH); 96 | WindowClass.lpszClassName := 'DoomXS'; 97 | if HPrevInst = 0 then 98 | begin 99 | WindowClass.hInstance := HInstance; 100 | WindowClass.hIcon := LoadIcon(HInstance, 'MAINICON'); 101 | WindowClass.hCursor := LoadCursor(0, nil); 102 | if RegisterClass(WindowClass) = 0 then 103 | Halt(1); 104 | end; 105 | 106 | hMainWnd := CreateWindowEx( 107 | 0, 108 | WindowClass.lpszClassName, 109 | AppTitle, 110 | WS_OVERLAPPED, 111 | 0, 0, 0, 0, 112 | 0, 113 | 0, 114 | HInstance, 115 | nil); 116 | 117 | SetWindowLong(hMainWnd, GWL_STYLE, 0); 118 | 119 | D_DoomMain; 120 | end; 121 | 122 | end. 123 | -------------------------------------------------------------------------------- /d_event.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit d_event; 28 | 29 | interface 30 | 31 | type 32 | evtype_t = (ev_keydown, ev_keyup, ev_mouse, ev_joystick); 33 | 34 | { Event structure. } 35 | { keys / mouse/joystick buttons } 36 | { mouse/joystick x move } 37 | { mouse/joystick y move } 38 | event_t = record 39 | typ: evtype_t; 40 | data1: integer; 41 | data2: integer; 42 | data3: integer; 43 | end; 44 | Pevent_t = ^event_t; 45 | 46 | gameaction_t = (ga_nothing, ga_loadlevel, ga_newgame, ga_loadgame, ga_savegame, 47 | ga_playdemo, ga_completed, ga_victory, ga_worlddone, ga_screenshot); 48 | 49 | { Button/action code definitions. } 50 | 51 | { Press "Fire". } 52 | { Use button, to open doors, activate switches. } 53 | { Flag: game events, not really buttons. } 54 | { Flag, weapon change pending. } 55 | { If True, the next 3 bits hold weapon num. } 56 | { The 3bit weapon mask and shift, convenience. } 57 | { Pause the game. } 58 | { Save the game at each console. } 59 | { Savegame slot numbers } 60 | { occupy the second byte of buttons. } 61 | 62 | const 63 | // Press "Fire". 64 | BT_ATTACK = 1; 65 | // Use button, to open doors, activate switches. 66 | BT_USE = 2; 67 | // Flag: game events, not really buttons. 68 | BT_SPECIAL = 128; 69 | BT_SPECIALMASK = 3; 70 | // Flag, weapon change pending. 71 | // If True, the next 3 bits hold weapon num. 72 | BT_CHANGE = 4; 73 | // The 3bit weapon mask and shift, convenience. 74 | BT_WEAPONMASK = (8 + 16 + 32); 75 | BT_WEAPONSHIFT = 3; 76 | // Pause the game. 77 | BTS_PAUSE = 1; 78 | // Save the game at each console. 79 | BTS_SAVEGAME = 2; 80 | // Savegame slot numbers 81 | // occupy the second byte of buttons. 82 | BTS_SAVEMASK = (4 + 8 + 16); 83 | BTS_SAVESHIFT = 2; 84 | 85 | { GLOBAL VARIABLES } 86 | const 87 | MAXEVENTS = 256; 88 | 89 | const 90 | NUMJOYBUTTONS = 12; 91 | 92 | var 93 | // EVENT HANDLING 94 | // Events are asynchronous inputs generally generated by the game user. 95 | // Events can be discarded if no responder claims them 96 | events: array[0..MAXEVENTS - 1] of event_t; 97 | eventhead: integer; 98 | eventtail: integer; 99 | 100 | implementation 101 | 102 | end. 103 | -------------------------------------------------------------------------------- /m_rnd.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit m_rnd; 28 | 29 | interface 30 | 31 | // Returns a number from 0 to 255, 32 | // from a lookup table. 33 | function M_Random: integer; 34 | 35 | // As M_Random, but used only by the play simulation. 36 | function P_Random: integer; 37 | 38 | // Fix randoms for demos. 39 | procedure M_ClearRandom; 40 | 41 | var 42 | rndindex: integer = 0; 43 | prndindex: integer = 0; 44 | 45 | implementation 46 | 47 | const 48 | rndtable: array[0..255] of byte = ( 49 | 0, 8, 109, 220, 222, 241, 149, 107, 75, 248, 254, 140, 16, 66, 50 | 74, 21, 211, 47, 80, 242, 154, 27, 205, 128, 161, 89, 77, 36, 51 | 95, 110, 85, 48, 212, 140, 211, 249, 22, 79, 200, 50, 28, 188, 52 | 52, 140, 202, 120, 68, 145, 62, 70, 184, 190, 91, 197, 152, 224, 53 | 149, 104, 25, 178, 252, 182, 202, 182, 141, 197, 4, 81, 181, 242, 54 | 145, 42, 39, 227, 156, 198, 225, 193, 219, 93, 122, 175, 249, 0, 55 | 175, 143, 70, 239, 46, 246, 163, 53, 163, 109, 168, 135, 2, 235, 56 | 25, 92, 20, 145, 138, 77, 69, 166, 78, 176, 173, 212, 166, 113, 57 | 94, 161, 41, 50, 239, 49, 111, 164, 70, 60, 2, 37, 171, 75, 58 | 136, 156, 11, 56, 42, 146, 138, 229, 73, 146, 77, 61, 98, 196, 59 | 135, 106, 63, 197, 195, 86, 96, 203, 113, 101, 170, 247, 181, 113, 60 | 80, 250, 108, 7, 255, 237, 129, 226, 79, 107, 112, 166, 103, 241, 61 | 24, 223, 239, 120, 198, 58, 60, 82, 128, 3, 184, 66, 143, 224, 62 | 145, 224, 81, 206, 163, 45, 63, 90, 168, 114, 59, 33, 159, 95, 63 | 28, 139, 123, 98, 125, 196, 15, 70, 194, 253, 54, 14, 109, 226, 64 | 71, 17, 161, 93, 186, 87, 244, 138, 20, 52, 123, 251, 26, 36, 65 | 17, 46, 52, 231, 232, 76, 31, 221, 84, 37, 216, 165, 212, 106, 66 | 197, 242, 98, 43, 39, 175, 254, 145, 190, 84, 118, 222, 187, 136, 67 | 120, 163, 236, 249 68 | ); 69 | 70 | // Which one is deterministic? 71 | function P_Random: integer; 72 | begin 73 | prndindex := (prndindex + 1) and $ff; 74 | Result := rndtable[prndindex]; 75 | end; 76 | 77 | function M_Random: integer; 78 | begin 79 | rndindex := (rndindex + 1) and $ff; 80 | Result := rndtable[rndindex]; 81 | end; 82 | 83 | procedure M_ClearRandom; 84 | begin 85 | rndindex := 0; 86 | prndindex := 0; 87 | end; 88 | 89 | end. 90 | -------------------------------------------------------------------------------- /d_items.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit d_items; 28 | 29 | interface 30 | 31 | uses 32 | doomdef, 33 | info_h; 34 | 35 | type 36 | { Weapon info: sprite frames, ammunition use. } 37 | weaponinfo_t = record 38 | ammo: ammotype_t; 39 | upstate: integer; 40 | downstate: integer; 41 | readystate: integer; 42 | atkstate: integer; 43 | flashstate: integer; 44 | end; 45 | Pweaponinfo_t = ^weaponinfo_t; 46 | 47 | // PSPRITE ACTIONS for waepons. 48 | // This struct controls the weapon animations. 49 | 50 | // Each entry is: 51 | // ammo/amunition type 52 | // upstate 53 | // downstate 54 | // readystate 55 | // atkstate, i.e. attack/fire/hit frame 56 | // flashstate, muzzle flash 57 | var 58 | weaponinfo: array[0..Ord(NUMWEAPONS) - 1] of weaponinfo_t = ( 59 | // fist 60 | (ammo: am_noammo; upstate: Ord(S_PUNCHUP); downstate: Ord(S_PUNCHDOWN); 61 | readystate: Ord(S_PUNCH); atkstate: Ord(S_PUNCH1); flashstate: Ord(S_NULL)), 62 | // pistol 63 | (ammo: am_clip; upstate: Ord(S_PISTOLUP); downstate: Ord(S_PISTOLDOWN); 64 | readystate: Ord(S_PISTOL); atkstate: Ord(S_PISTOL1); flashstate: Ord(S_PISTOLFLASH)), 65 | // shotgun 66 | (ammo: am_shell; upstate: Ord(S_SGUNUP); downstate: Ord(S_SGUNDOWN); 67 | readystate: Ord(S_SGUN); atkstate: Ord(S_SGUN1); flashstate: Ord(S_SGUNFLASH1)), 68 | // chaingun 69 | (ammo: am_clip; upstate: Ord(S_CHAINUP); downstate: Ord(S_CHAINDOWN); 70 | readystate: Ord(S_CHAIN); atkstate: Ord(S_CHAIN1); flashstate: Ord(S_CHAINFLASH1)), 71 | // missile launcher 72 | (ammo: am_misl; upstate: Ord(S_MISSILEUP); downstate: Ord(S_MISSILEDOWN); 73 | readystate: Ord(S_MISSILE); atkstate: Ord(S_MISSILE1); flashstate: Ord(S_MISSILEFLASH1)), 74 | // plasma rifle 75 | (ammo: am_cell; upstate: Ord(S_PLASMAUP); downstate: Ord(S_PLASMADOWN); 76 | readystate: Ord(S_PLASMA); atkstate: Ord(S_PLASMA1); flashstate: Ord(S_PLASMAFLASH1)), 77 | // bfg 9000 78 | (ammo: am_cell; upstate: Ord(S_BFGUP); downstate: Ord(S_BFGDOWN); 79 | readystate: Ord(S_BFG); atkstate: Ord(S_BFG1); flashstate: Ord(S_BFGFLASH1)), 80 | // chainsaw 81 | (ammo: am_noammo; upstate: Ord(S_SAWUP); downstate: Ord(S_SAWDOWN); 82 | readystate: Ord(S_SAW); atkstate: Ord(S_SAW1); flashstate: Ord(S_NULL)), 83 | // super shotgun 84 | (ammo: am_shell; upstate: Ord(S_DSGUNUP); downstate: Ord(S_DSGUNDOWN); 85 | readystate: Ord(S_DSGUN); atkstate: Ord(S_DSGUN1); flashstate: Ord(S_DSGUNFLASH1)) 86 | ); 87 | 88 | implementation 89 | 90 | end. 91 | -------------------------------------------------------------------------------- /m_cheat.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit m_cheat; 28 | 29 | interface 30 | 31 | type 32 | cheatseq_t = record 33 | sequence: string; 34 | p: string; 35 | end; 36 | Pcheatseq_t = ^cheatseq_t; 37 | 38 | function cht_CheckCheat(cht: Pcheatseq_t; key: char): boolean; 39 | 40 | procedure cht_GetParam(cht: Pcheatseq_t; var buffer: string); 41 | 42 | function get_cheatseq_string(const A: array of char): string; overload; 43 | 44 | function get_cheatseq_string(const A: string): string; overload; 45 | 46 | implementation 47 | 48 | uses 49 | d_delphi; 50 | 51 | function get_cheatseq_string(const A: array of char): string; 52 | var 53 | i: integer; 54 | begin 55 | Result := ''; 56 | i := 0; 57 | repeat 58 | Result := Result + A[i]; 59 | Inc(i); 60 | until A[i] = Chr($FF); 61 | end; 62 | 63 | function get_cheatseq_string(const A: string): string; 64 | var 65 | i: integer; 66 | begin 67 | Result := ''; 68 | i := 1; 69 | repeat 70 | Result := Result + A[i]; 71 | Inc(i); 72 | until A[i] = Chr($FF); 73 | end; 74 | 75 | function SCRAMBLE(a: integer): integer; 76 | begin 77 | Result := _SHL(a and 1, 7) + _SHL(a and 2, 5) + 78 | (a and 4) + _SHL(a and 8, 1) + _SHR(a and 16, 1) + 79 | (a and 32) + _SHR(a and 64, 5) + _SHR(a and 128, 7); 80 | end; 81 | 82 | var 83 | firsttime: boolean = True; 84 | cheat_xlate_table: array[0..255] of char; 85 | 86 | // Called in st_stuff module, which handles the input. 87 | // Returns a 1 if the cheat was successful, 0 if failed. 88 | function cht_CheckCheat(cht: Pcheatseq_t; key: char): boolean; 89 | var 90 | i: integer; 91 | begin 92 | Result := False; 93 | 94 | if firsttime then 95 | begin 96 | firsttime := False; 97 | for i := 0 to 255 do 98 | cheat_xlate_table[i] := Chr(SCRAMBLE(i)); 99 | end; 100 | 101 | if cht.p = '' then 102 | cht.p := cht.sequence; // initialize if first time 103 | 104 | if Length(cht.p) = 0 then 105 | cht.p := key 106 | else if cht.p[1] = #0 then 107 | cht.p[1] := key 108 | else if (Length(cht.p) > 1) and (cht.p[2] = #0) then 109 | begin 110 | cht.p[2] := key; 111 | Result := True; 112 | end 113 | else if cheat_xlate_table[Ord(key)] = cht.p[1] then 114 | Delete(cht.p, 1, 1) 115 | else 116 | cht.p := cht.sequence; 117 | 118 | if Length(cht.p) > 0 then 119 | begin 120 | if cht.p[1] = #1 then 121 | Delete(cht.p, 1, 1) 122 | else if cht.p[1] = Chr($FF) then // end of sequence character 123 | begin 124 | cht.p := cht.sequence; 125 | Result := True; 126 | end; 127 | end 128 | else 129 | Result := True; 130 | end; 131 | 132 | procedure cht_GetParam(cht: Pcheatseq_t; var buffer: string); 133 | begin 134 | buffer := cht.p; 135 | end; 136 | 137 | end. 138 | -------------------------------------------------------------------------------- /DoomXS.dpr: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | program DoomXS; 28 | 29 | {$R *.RES} 30 | 31 | uses 32 | am_map in 'am_map.pas', 33 | d_englsh in 'd_englsh.pas', 34 | d_event in 'd_event.pas', 35 | d_items in 'd_items.pas', 36 | d_main in 'd_main.pas', 37 | d_delphi in 'd_delphi.pas', 38 | d_net in 'd_net.pas', 39 | d_player in 'd_player.pas', 40 | d_think in 'd_think.pas', 41 | d_ticcmd in 'd_ticcmd.pas', 42 | doomdata in 'doomdata.pas', 43 | doomdef in 'doomdef.pas', 44 | doomstat in 'doomstat.pas', 45 | f_finale in 'f_finale.pas', 46 | f_wipe in 'f_wipe.pas', 47 | g_game in 'g_game.pas', 48 | hu_lib in 'hu_lib.pas', 49 | hu_stuff in 'hu_stuff.pas', 50 | i_main in 'i_main.pas', 51 | i_net in 'i_net.pas', 52 | info in 'info.pas', 53 | info_h in 'info_h.pas', 54 | i_system in 'i_system.pas', 55 | m_argv in 'm_argv.pas', 56 | m_bbox in 'm_bbox.pas', 57 | m_cheat in 'm_cheat.pas', 58 | m_fixed in 'm_fixed.pas', 59 | m_menu in 'm_menu.pas', 60 | m_misc in 'm_misc.pas', 61 | m_rnd in 'm_rnd.pas', 62 | tables in 'tables.pas', 63 | p_ceilng in 'p_ceilng.pas', 64 | p_doors in 'p_doors.pas', 65 | p_enemy in 'p_enemy.pas', 66 | p_floor in 'p_floor.pas', 67 | p_inter in 'p_inter.pas', 68 | p_lights in 'p_lights.pas', 69 | p_local in 'p_local.pas', 70 | p_map in 'p_map.pas', 71 | p_maputl in 'p_maputl.pas', 72 | p_mobj in 'p_mobj.pas', 73 | p_mobj_h in 'p_mobj_h.pas', 74 | z_memory in 'z_memory.pas', 75 | p_plats in 'p_plats.pas', 76 | p_pspr in 'p_pspr.pas', 77 | p_pspr_h in 'p_pspr_h.pas', 78 | p_saveg in 'p_saveg.pas', 79 | p_setup in 'p_setup.pas', 80 | p_sight in 'p_sight.pas', 81 | w_wad in 'w_wad.pas', 82 | p_tick in 'p_tick.pas', 83 | p_telept in 'p_telept.pas', 84 | p_switch in 'p_switch.pas', 85 | p_spec in 'p_spec.pas', 86 | p_user in 'p_user.pas', 87 | r_bsp in 'r_bsp.pas', 88 | r_data in 'r_data.pas', 89 | r_defs in 'r_defs.pas', 90 | r_draw in 'r_draw.pas', 91 | r_main in 'r_main.pas', 92 | r_plane in 'r_plane.pas', 93 | r_segs in 'r_segs.pas', 94 | r_sky in 'r_sky.pas', 95 | r_things in 'r_things.pas', 96 | s_sound in 's_sound.pas', 97 | sounds in 'sounds.pas', 98 | st_lib in 'st_lib.pas', 99 | st_stuff in 'st_stuff.pas', 100 | v_video in 'v_video.pas', 101 | wi_stuff in 'wi_stuff.pas', 102 | i_video in 'i_video.pas', 103 | i_sound in 'i_sound.pas', 104 | i_music in 'i_music.pas', 105 | i_input in 'i_input.pas', 106 | i_io in 'i_io.pas', 107 | i_midi in 'i_midi.pas', 108 | DirectDraw in 'DirectDraw.pas', 109 | DirectSound in 'DirectSound.pas', 110 | DXTypes in 'DXTypes.pas', 111 | r_intrpl in 'r_intrpl.pas'; 112 | 113 | var 114 | Saved8087CW: Word; 115 | 116 | begin 117 | { Save the current FPU state and then disable FPU exceptions } 118 | Saved8087CW := Default8087CW; 119 | Set8087CW($133f); { Disable all fpu exceptions } 120 | 121 | DoomMain; 122 | 123 | { Reset the FPU to the previous state } 124 | Set8087CW(Saved8087CW); 125 | 126 | end. 127 | -------------------------------------------------------------------------------- /DoomXSL.lpr: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | program DoomXSL; 28 | 29 | uses 30 | am_map in 'am_map.pas', 31 | d_englsh in 'd_englsh.pas', 32 | d_event in 'd_event.pas', 33 | d_items in 'd_items.pas', 34 | d_main in 'd_main.pas', 35 | d_delphi in 'd_delphi.pas', 36 | d_net in 'd_net.pas', 37 | d_player in 'd_player.pas', 38 | d_think in 'd_think.pas', 39 | d_ticcmd in 'd_ticcmd.pas', 40 | doomdata in 'doomdata.pas', 41 | doomdef in 'doomdef.pas', 42 | doomstat in 'doomstat.pas', 43 | f_finale in 'f_finale.pas', 44 | f_wipe in 'f_wipe.pas', 45 | g_game in 'g_game.pas', 46 | hu_lib in 'hu_lib.pas', 47 | hu_stuff in 'hu_stuff.pas', 48 | i_main in 'i_main.pas', 49 | i_net in 'i_net.pas', 50 | info in 'info.pas', 51 | info_h in 'info_h.pas', 52 | i_system in 'i_system.pas', 53 | m_argv in 'm_argv.pas', 54 | m_bbox in 'm_bbox.pas', 55 | m_cheat in 'm_cheat.pas', 56 | m_fixed in 'm_fixed.pas', 57 | m_menu in 'm_menu.pas', 58 | m_misc in 'm_misc.pas', 59 | m_rnd in 'm_rnd.pas', 60 | tables in 'tables.pas', 61 | p_ceilng in 'p_ceilng.pas', 62 | p_doors in 'p_doors.pas', 63 | p_enemy in 'p_enemy.pas', 64 | p_floor in 'p_floor.pas', 65 | p_inter in 'p_inter.pas', 66 | p_lights in 'p_lights.pas', 67 | p_local in 'p_local.pas', 68 | p_map in 'p_map.pas', 69 | p_maputl in 'p_maputl.pas', 70 | p_mobj in 'p_mobj.pas', 71 | p_mobj_h in 'p_mobj_h.pas', 72 | z_memory in 'z_memory.pas', 73 | p_plats in 'p_plats.pas', 74 | p_pspr in 'p_pspr.pas', 75 | p_pspr_h in 'p_pspr_h.pas', 76 | p_saveg in 'p_saveg.pas', 77 | p_setup in 'p_setup.pas', 78 | p_sight in 'p_sight.pas', 79 | w_wad in 'w_wad.pas', 80 | p_tick in 'p_tick.pas', 81 | p_telept in 'p_telept.pas', 82 | p_switch in 'p_switch.pas', 83 | p_spec in 'p_spec.pas', 84 | p_user in 'p_user.pas', 85 | r_bsp in 'r_bsp.pas', 86 | r_data in 'r_data.pas', 87 | r_defs in 'r_defs.pas', 88 | r_draw in 'r_draw.pas', 89 | r_main in 'r_main.pas', 90 | r_plane in 'r_plane.pas', 91 | r_segs in 'r_segs.pas', 92 | r_sky in 'r_sky.pas', 93 | r_things in 'r_things.pas', 94 | s_sound in 's_sound.pas', 95 | sounds in 'sounds.pas', 96 | st_lib in 'st_lib.pas', 97 | st_stuff in 'st_stuff.pas', 98 | v_video in 'v_video.pas', 99 | wi_stuff in 'wi_stuff.pas', 100 | i_video in 'i_video.pas', 101 | i_sound in 'i_sound.pas', 102 | i_music in 'i_music.pas', 103 | i_input in 'i_input.pas', 104 | i_io in 'i_io.pas', 105 | i_midi in 'i_midi.pas', 106 | DirectDraw in 'DirectDraw.pas', 107 | DirectSound in 'DirectSound.pas', 108 | DXTypes in 'DXTypes.pas', 109 | r_intrpl in 'r_intrpl.pas'; 110 | 111 | var 112 | Saved8087CW: Word; 113 | 114 | {$R *.res} 115 | 116 | begin 117 | { Save the current FPU state and then disable FPU exceptions } 118 | Saved8087CW := Default8087CW; 119 | Set8087CW($133f); { Disable all fpu exceptions } 120 | 121 | DoomMain; 122 | 123 | { Reset the FPU to the previous state } 124 | Set8087CW(Saved8087CW); 125 | 126 | end. 127 | -------------------------------------------------------------------------------- /p_tick.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_tick; 28 | 29 | interface 30 | 31 | uses 32 | d_think; 33 | 34 | // THINKERS 35 | // All thinkers should be allocated by Z_Malloc 36 | // so they can be operated on uniformly. 37 | // The actual structures will vary in size, 38 | // but the first element must be thinker_t. 39 | 40 | var 41 | // Both the head and tail of the thinker list. 42 | thinkercap: thinker_t; 43 | 44 | procedure P_InitThinkers; 45 | 46 | procedure P_AddThinker(thinker: Pthinker_t); 47 | 48 | procedure P_RemoveThinker(thinker: Pthinker_t); 49 | 50 | procedure P_Ticker; 51 | 52 | var 53 | leveltime: integer; 54 | 55 | implementation 56 | 57 | uses 58 | doomdef, 59 | d_player, 60 | g_game, 61 | m_menu, 62 | p_user, 63 | p_spec, 64 | p_mobj, 65 | z_memory; 66 | 67 | procedure P_InitThinkers; 68 | begin 69 | thinkercap.prev := @thinkercap; 70 | thinkercap.next := @thinkercap; 71 | end; 72 | 73 | // P_AddThinker 74 | // Adds a new thinker at the end of the list. 75 | procedure P_AddThinker(thinker: Pthinker_t); 76 | begin 77 | thinkercap.prev.next := thinker; 78 | thinker.next := @thinkercap; 79 | thinker.prev := thinkercap.prev; 80 | thinkercap.prev := thinker; 81 | end; 82 | 83 | // P_RemoveThinker 84 | // Deallocation is lazy -- it will not actually be freed 85 | // until its thinking turn comes up. 86 | procedure P_RemoveThinker(thinker: Pthinker_t); 87 | begin 88 | // FIXME: NOP. 89 | thinker.func.acv := nil; 90 | end; 91 | 92 | // P_RunThinkers 93 | procedure P_RunThinkers; 94 | var 95 | currentthinker: Pthinker_t; 96 | nextthinker: Pthinker_t; 97 | begin 98 | currentthinker := thinkercap.next; 99 | while currentthinker <> @thinkercap do 100 | begin 101 | if not Assigned(currentthinker.func.acv) then 102 | begin 103 | // time to remove it 104 | currentthinker.next.prev := currentthinker.prev; 105 | currentthinker.prev.next := currentthinker.next; 106 | nextthinker := currentthinker.next; // JVAL: 20201228 - Keep next pointer in nextthinker 107 | Z_Free(currentthinker); 108 | currentthinker := nextthinker; // JVAL: 20201228 - Set currentthinker to next pointer 109 | end 110 | else 111 | begin 112 | if Assigned(currentthinker.func.acp1) then 113 | currentthinker.func.acp1(currentthinker); 114 | currentthinker := currentthinker.next; 115 | end; 116 | end; 117 | end; 118 | 119 | // P_Ticker 120 | procedure P_Ticker; 121 | var 122 | i: integer; 123 | begin 124 | // run the tic 125 | if paused then 126 | Exit; 127 | 128 | // pause if in menu and at least one tic has been run 129 | if not netgame and menuactive and not demoplayback and 130 | (players[consoleplayer].viewz <> 1) then 131 | Exit; 132 | 133 | for i := 0 to MAXPLAYERS - 1 do 134 | if playeringame[i] then 135 | P_PlayerThink(@players[i]); 136 | 137 | P_RunThinkers; 138 | P_UpdateSpecials; 139 | P_RespawnSpecials; 140 | 141 | // for par times 142 | Inc(leveltime); 143 | end; 144 | 145 | end. 146 | -------------------------------------------------------------------------------- /p_telept.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_telept; 28 | 29 | interface 30 | 31 | uses 32 | p_mobj_h, 33 | r_defs; 34 | 35 | // TELEPORTATION 36 | function EV_Teleport(line: Pline_t; side: integer; thing: Pmobj_t): integer; 37 | 38 | implementation 39 | 40 | uses 41 | doomdef, 42 | doomstat, 43 | d_think, 44 | d_player, 45 | info_h, 46 | m_fixed, 47 | p_setup, 48 | p_tick, 49 | p_mobj, 50 | p_map, 51 | s_sound, 52 | sounds, 53 | tables; 54 | 55 | function EV_Teleport(line: Pline_t; side: integer; thing: Pmobj_t): integer; 56 | var 57 | i: integer; 58 | tag: integer; 59 | m: Pmobj_t; 60 | fog: Pmobj_t; 61 | an: LongWord; 62 | thinker: Pthinker_t; 63 | sector: Psector_t; 64 | oldx: fixed_t; 65 | oldy: fixed_t; 66 | oldz: fixed_t; 67 | plyr: Pplayer_t; 68 | begin 69 | // don't teleport missiles 70 | if thing.flags and MF_MISSILE <> 0 then 71 | begin 72 | Result := 0; 73 | Exit; 74 | end; 75 | 76 | // Don't teleport if hit back of line, 77 | // so you can get out of teleporter. 78 | if side = 1 then 79 | begin 80 | Result := 0; 81 | Exit; 82 | end; 83 | 84 | tag := line.tag; 85 | for i := 0 to numsectors - 1 do 86 | begin 87 | if sectors[i].tag = tag then 88 | begin 89 | thinker := thinkercap.next; 90 | while thinker <> @thinkercap do 91 | begin 92 | // not a mobj 93 | if @thinker.func.acp1 <> @P_MobjThinker then 94 | begin 95 | thinker := thinker.next; 96 | Continue; 97 | end; 98 | 99 | m := Pmobj_t(thinker); 100 | 101 | // not a teleportman 102 | if m.typ <> MT_TELEPORTMAN then 103 | begin 104 | thinker := thinker.next; 105 | Continue; 106 | end; 107 | 108 | sector := Psubsector_t(m.subsector).sector; 109 | // wrong sector 110 | if sector <> @sectors[i] then 111 | begin 112 | thinker := thinker.next; 113 | Continue; 114 | end; 115 | 116 | oldx := thing.x; 117 | oldy := thing.y; 118 | oldz := thing.z; 119 | 120 | if not P_TeleportMove(thing, m.x, m.y) then 121 | begin 122 | Result := 0; 123 | Exit; 124 | end; 125 | 126 | if not (gamemission in [pack_tnt, pack_plut]) then 127 | thing.z := thing.floorz; //fixme: not needed? 128 | plyr := thing.player; 129 | if plyr <> nil then 130 | plyr.viewz := thing.z + plyr.viewheight; 131 | 132 | // spawn teleport fog at source and destination 133 | fog := P_SpawnMobj(oldx, oldy, oldz, MT_TFOG); 134 | S_StartSound(fog, Ord(sfx_telept)); 135 | an := m.angle shr ANGLETOFINESHIFT; 136 | fog := P_SpawnMobj(m.x + 20 * finecosine[an], m.y + 137 | 20 * finesine[an], thing.z, MT_TFOG); 138 | 139 | // emit sound, where? 140 | S_StartSound(fog, Ord(sfx_telept)); 141 | 142 | // don't move for a bit 143 | if plyr <> nil then 144 | thing.reactiontime := 18; 145 | 146 | thing.angle := m.angle; 147 | thing.momx := 0; 148 | thing.momy := 0; 149 | thing.momz := 0; 150 | Result := 1; 151 | Exit; 152 | end; 153 | end; 154 | end; 155 | Result := 0; 156 | end; 157 | 158 | end. 159 | 160 | -------------------------------------------------------------------------------- /doomdef.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit doomdef; 28 | 29 | interface 30 | 31 | // 32 | // Global parameters/defines. 33 | // 34 | // DOOM version 35 | const 36 | VERSION = 109; 37 | 38 | type 39 | // Game mode handling - identify IWAD version 40 | // to handle IWAD dependend animations etc. 41 | GameMode_t = ( 42 | shareware, // DOOM 1 shareware, E1, M9 43 | registered, // DOOM 1 registered, E3, M27 44 | commercial, // DOOM 2 retail, E1 M34 45 | /////////// // DOOM 2 german edition not handled 46 | retail, // DOOM 1 retail, E4, M36 47 | indetermined // Well, no IWAD found. 48 | ); 49 | 50 | // Mission packs - might be useful for TC stuff? 51 | GameMission_t = ( 52 | doom, // DOOM 1 53 | doom2, // DOOM 2 54 | pack_tnt, // TNT mission pack 55 | pack_plut, // Plutonia pack 56 | none 57 | ); 58 | 59 | // Identify language to use, software localization. 60 | Language_t = ( 61 | english, 62 | french, 63 | german, 64 | unknown 65 | ); 66 | 67 | const 68 | SCREENWIDTH = 640; 69 | SCREENHEIGHT = 400; 70 | 71 | const 72 | // The maximum number of players, multiplayer/networking. 73 | MAXPLAYERS = 4; 74 | 75 | // State updates, number of tics / second. 76 | TICRATE = 35; 77 | 78 | // The current state of the game: whether we are 79 | // playing, gazing at the intermission screen, 80 | // the game final animation, or a demo. 81 | type 82 | gamestate_t = ( 83 | GS_LEVEL, 84 | GS_INTERMISSION, 85 | GS_FINALE, 86 | GS_DEMOSCREEN 87 | ); 88 | 89 | const 90 | // Difficulty/skill settings/filters. 91 | 92 | // Skill flags. 93 | MTF_EASY = 1; 94 | MTF_NORMAL = 2; 95 | MTF_HARD = 4; 96 | 97 | // Deaf monsters/do not react to sound. 98 | MTF_AMBUSH = 8; 99 | 100 | type 101 | skill_t = ( 102 | sk_baby, 103 | sk_easy, 104 | sk_medium, 105 | sk_hard, 106 | sk_nightmare 107 | ); 108 | 109 | // Key cards. 110 | card_t = ( 111 | it_bluecard, 112 | it_yellowcard, 113 | it_redcard, 114 | it_blueskull, 115 | it_yellowskull, 116 | it_redskull, 117 | NUMCARDS 118 | ); 119 | 120 | // The defined weapons, 121 | // including a marker indicating 122 | // user has not changed weapon. 123 | weapontype_t = ( 124 | wp_fist, 125 | wp_pistol, 126 | wp_shotgun, 127 | wp_chaingun, 128 | wp_missile, 129 | wp_plasma, 130 | wp_bfg, 131 | wp_chainsaw, 132 | wp_supershotgun, 133 | NUMWEAPONS, 134 | // No pending weapon change. 135 | wp_nochange 136 | ); 137 | 138 | // Ammunition types defined. 139 | ammotype_t = ( 140 | am_clip, // Pistol / chaingun ammo. 141 | am_shell, // Shotgun / double barreled shotgun. 142 | am_cell, // Plasma rifle, BFG. 143 | am_misl, // Missile launcher. 144 | NUMAMMO, 145 | am_noammo // Unlimited for chainsaw / fist. 146 | ); 147 | 148 | // Power up artifacts. 149 | powertype_t = ( 150 | pw_invulnerability, 151 | pw_strength, 152 | pw_invisibility, 153 | pw_ironfeet, 154 | pw_allmap, 155 | pw_infrared, 156 | NUMPOWERS 157 | ); 158 | Ppowertype_t = ^powertype_t; 159 | 160 | // 161 | // Power up durations, 162 | // how many seconds till expiration, 163 | // assuming TICRATE is 35 ticks/second. 164 | // 165 | const 166 | INVULNTICS = 30 * TICRATE; 167 | INVISTICS = 60 * TICRATE; 168 | INFRATICS = 120 * TICRATE; 169 | IRONTICS = 60 * TICRATE; 170 | 171 | // DOOM keyboard definition. 172 | // This is the stuff configured by Setup.Exe. 173 | // Most key data are simple ascii (uppercased). 174 | const 175 | KEY_RIGHTARROW = $ae; 176 | KEY_LEFTARROW = $ac; 177 | KEY_UPARROW = $ad; 178 | KEY_DOWNARROW = $af; 179 | KEY_ESCAPE = 27; 180 | KEY_ENTER = 13; 181 | KEY_TAB = 9; 182 | 183 | KEY_F1 = $80 + $3b; 184 | KEY_F2 = $80 + $3c; 185 | KEY_F3 = $80 + $3d; 186 | KEY_F4 = $80 + $3e; 187 | KEY_F5 = $80 + $3f; 188 | KEY_F6 = $80 + $40; 189 | KEY_F7 = $80 + $41; 190 | KEY_F8 = $80 + $42; 191 | KEY_F9 = $80 + $43; 192 | KEY_F10 = $80 + $44; 193 | KEY_F11 = $80 + $57; 194 | KEY_F12 = $80 + $58; 195 | 196 | KEY_PRNT = $80 + $59; 197 | 198 | KEY_BACKSPACE = 127; 199 | KEY_PAUSE = $ff; 200 | 201 | KEY_EQUALS = $3d; 202 | KEY_MINUS = $2d; 203 | 204 | KEY_RSHIFT = $80 + $36; 205 | KEY_RCTRL = $80 + $1d; 206 | KEY_RALT = $80 + $38; 207 | 208 | KEY_PAGEDOWN = $80 + $45; 209 | KEY_PAGEUP = $80 + $46; 210 | KEY_INS = $80 + $47; 211 | 212 | implementation 213 | 214 | end. 215 | -------------------------------------------------------------------------------- /f_wipe.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit f_wipe; 28 | 29 | interface 30 | 31 | procedure wipe_StartScreen; 32 | 33 | procedure wipe_EndScreen; 34 | 35 | function wipe_Ticker(ticks: integer): boolean; 36 | 37 | implementation 38 | 39 | uses 40 | doomdef, 41 | d_delphi, 42 | m_rnd, 43 | m_fixed, 44 | i_video, 45 | v_video, 46 | z_memory; 47 | 48 | // SCREEN WIPE PACKAGE 49 | 50 | var 51 | wipe_scr_start: PByteArray; 52 | wipe_scr_end: PByteArray; 53 | 54 | procedure wipe_shittyColMajorXform(_array: PByteArray; width, height: integer); 55 | var 56 | x, y: integer; 57 | dest: PByteArray; 58 | begin 59 | dest := Z_Malloc(width * height, PU_STATIC, nil); 60 | 61 | for y := 0 to height - 1 do 62 | for x := 0 to width - 1 do 63 | dest[x * height + y] := _array[y * width + x]; 64 | 65 | memcpy(_array, dest, width * height); 66 | 67 | Z_Free(dest); 68 | end; 69 | 70 | var 71 | yy: Pfixed_tArray; 72 | vy: fixed_t; 73 | 74 | procedure wipe_initMelt; 75 | var 76 | i, r: integer; 77 | SHEIGHTS: array[0..SCREENWIDTH - 1] of integer; 78 | RANDOMS: array[0..319] of byte; 79 | begin 80 | for i := 0 to SCREENWIDTH - 1 do 81 | SHEIGHTS[i] := Trunc(i * 320 / SCREENWIDTH); 82 | for i := 0 to 319 do 83 | RANDOMS[i] := M_Random; 84 | 85 | // copy start screen to main screen 86 | memcpy(screens[SCN_FG], wipe_scr_start, SCREENWIDTH * SCREENHEIGHT); 87 | 88 | wipe_shittyColMajorXform(wipe_scr_start, SCREENWIDTH, SCREENHEIGHT); 89 | wipe_shittyColMajorXform(wipe_scr_end, SCREENWIDTH, SCREENHEIGHT); 90 | 91 | // setup initial column positions 92 | // (y<0 => not ready to scroll yet) 93 | yy := Z_Malloc(SCREENWIDTH * SizeOf(integer), PU_STATIC, nil); 94 | yy[0] := -(M_Random mod 16); 95 | for i := 1 to SCREENWIDTH - 1 do 96 | begin 97 | r := (RANDOMS[SHEIGHTS[i]] mod 3) - 1; 98 | yy[i] := yy[i - 1] + r; 99 | if yy[i] > 0 then 100 | yy[i] := 0 101 | else if yy[i] = -16 then 102 | yy[i] := -15; 103 | end; 104 | 105 | // JVAL change wipe timing 106 | vy := FRACUNIT * SCREENWIDTH div 200; 107 | for i := 0 to SCREENWIDTH - 1 do 108 | yy[i] := yy[i] * vy; 109 | 110 | for i := 1 to SCREENWIDTH - 1 do 111 | if SHEIGHTS[i - 1] = SHEIGHTS[i] then 112 | yy[i] := yy[i - 1]; 113 | end; 114 | 115 | function wipe_doMelt(ticks: integer): integer; 116 | var 117 | i: integer; 118 | j: integer; 119 | dy: fixed_t; 120 | idx: integer; 121 | s: PByteArray; 122 | d: PByteArray; 123 | begin 124 | Result := 1; 125 | 126 | while ticks > 0 do 127 | begin 128 | for i := 0 to SCREENWIDTH - 1 do 129 | begin 130 | if yy[i] < 0 then 131 | begin 132 | yy[i] := yy[i] + vy; 133 | Result := 0; 134 | end 135 | else if yy[i] < SCREENHEIGHT * FRACUNIT then 136 | begin 137 | if yy[i] <= 15 * vy then 138 | dy := yy[i] + vy 139 | else 140 | dy := 8 * vy; 141 | if (yy[i] + dy) div FRACUNIT >= SCREENHEIGHT then 142 | dy := SCREENHEIGHT * FRACUNIT - yy[i]; 143 | s := PByteArray(integer(wipe_scr_end) + i * SCREENHEIGHT + yy[i] div FRACUNIT); 144 | d := PByteArray(integer(screens[SCN_FG]) + yy[i] div FRACUNIT * SCREENWIDTH + i); 145 | idx := 0; 146 | for j := 0 to dy div FRACUNIT do //- 1 do 147 | begin 148 | d[idx] := s[j]; 149 | idx := idx + SCREENWIDTH; 150 | end; 151 | yy[i] := yy[i] + dy; 152 | s := PByteArray(integer(wipe_scr_start) + i * SCREENHEIGHT); 153 | d := PByteArray(integer(screens[SCN_FG]) + yy[i] div FRACUNIT * SCREENWIDTH + i); 154 | 155 | idx := 0; 156 | for j := 0 to SCREENHEIGHT - yy[i] div FRACUNIT - 1 do 157 | begin 158 | d[idx] := s[j]; 159 | idx := idx + SCREENWIDTH; 160 | end; 161 | Result := 0; 162 | end; 163 | end; 164 | dec(ticks); 165 | end; 166 | end; 167 | 168 | procedure wipe_exitMelt; 169 | begin 170 | Z_Free(yy); 171 | end; 172 | 173 | procedure wipe_StartScreen; 174 | begin 175 | wipe_scr_start := screens[SCN_WIPE_START]; 176 | I_ReadScreen(wipe_scr_start); 177 | end; 178 | 179 | procedure wipe_EndScreen; 180 | begin 181 | wipe_scr_end := screens[SCN_WIPE_END]; 182 | I_ReadScreen(wipe_scr_end); 183 | end; 184 | 185 | var 186 | wiping: boolean = False; 187 | 188 | // when zero, stop the wipe 189 | function wipe_Ticker(ticks: integer): boolean; 190 | begin 191 | // initial stuff 192 | if not wiping then 193 | begin 194 | wiping := True; 195 | wipe_initMelt; 196 | end; 197 | 198 | // do a piece of wipe-in 199 | if wipe_doMelt(ticks) <> 0 then 200 | begin 201 | // final stuff 202 | wiping := False; 203 | wipe_exitMelt; 204 | end; 205 | 206 | Result := not wiping; 207 | end; 208 | 209 | end. 210 | -------------------------------------------------------------------------------- /d_player.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit d_player; 28 | 29 | interface 30 | 31 | uses 32 | // The player data structure depends on a number 33 | // of other structs: items (internal inventory), 34 | // animation states (closely tied to the sprites 35 | // used to represent them, unfortunately). 36 | p_pspr_h, 37 | // In addition, the player is just a special 38 | // case of the generic moving object/actor. 39 | p_mobj_h, 40 | // Finally, for odd reasons, the player input 41 | // is buffered within the player data struct, 42 | // as commands per game tick. 43 | d_ticcmd, 44 | m_fixed, 45 | doomdef; 46 | 47 | // Player states. 48 | type 49 | playerstate_t = ( 50 | PST_LIVE, // Playing or camping. 51 | PST_DEAD, // Dead on the ground, view follows killer. 52 | PST_REBORN // Ready to restart/respawn??? 53 | ); 54 | 55 | // Player internal flags, for cheats and debug. 56 | const 57 | CF_NOCLIP = 1; // No clipping, walk through barriers. 58 | CF_GODMODE = 2; // No damage, no health loss. 59 | CF_NOMOMENTUM = 4; // Not really a cheat, just a debug aid. 60 | 61 | type 62 | // Extended player object info: player_t 63 | player_t = record 64 | mo: Pmobj_t; 65 | playerstate: playerstate_t; 66 | cmd: ticcmd_t; 67 | 68 | // Determine POV, 69 | // including viewpoint bobbing during movement. 70 | // Focal origin above r.z 71 | viewz: fixed_t; 72 | // Base height above floor for viewz. 73 | viewheight: fixed_t; 74 | // Bob/squat speed. 75 | deltaviewheight: fixed_t; 76 | // bounded/scaled total momentum. 77 | bob: fixed_t; 78 | 79 | // This is only used between levels, 80 | // mo->health is used during levels. 81 | health: integer; 82 | armorpoints: integer; 83 | // Armor type is 0-2. 84 | armortype: integer; 85 | 86 | // Power ups. invinc and invis are tic counters. 87 | powers: array[0..Ord(NUMPOWERS) - 1] of integer; 88 | cards: array[0..Ord(NUMCARDS) - 1] of boolean; 89 | backpack: boolean; 90 | 91 | // Frags, kills of other players. 92 | frags: array[0..MAXPLAYERS - 1] of integer; 93 | readyweapon: weapontype_t; 94 | 95 | // Is wp_nochange if not changing. 96 | pendingweapon: weapontype_t; 97 | 98 | weaponowned: array[0..Ord(NUMWEAPONS) - 1] of integer; 99 | ammo: array[0..Ord(NUMAMMO) - 1] of integer; 100 | maxammo: array[0..Ord(NUMAMMO) - 1] of integer; 101 | 102 | // True if button down last tic. 103 | attackdown: boolean; 104 | usedown: boolean; 105 | 106 | // Bit flags, for cheats and debug. 107 | // See cheat_t, above. 108 | cheats: integer; 109 | 110 | // Refired shots are less accurate. 111 | refire: integer; 112 | 113 | // For intermission stats. 114 | killcount: integer; 115 | itemcount: integer; 116 | secretcount: integer; 117 | 118 | // Hint messages. 119 | msg: string[255]; 120 | 121 | // For screen flashing (red or bright). 122 | damagecount: integer; 123 | bonuscount: integer; 124 | 125 | // Who did damage (NULL for floors/ceilings). 126 | attacker: Pmobj_t; 127 | 128 | // So gun flashes light up areas. 129 | extralight: integer; 130 | 131 | // Current PLAYPAL, ??? 132 | // can be set to REDCOLORMAP for pain, etc. 133 | fixedcolormap: integer; 134 | 135 | // Player skin colorshift, 136 | // 0-3 for which color to draw player. 137 | colormap: integer; 138 | 139 | // Overlay view sprites (gun, etc). 140 | psprites: array[0..Ord(NUMPSPRITES) - 1] of pspdef_t; 141 | 142 | // True if secret level has been done. 143 | didsecret: boolean; 144 | end; 145 | Pplayer_t = ^player_t; 146 | 147 | // INTERMISSION 148 | // Structure passed e.g. to WI_Start(wb) 149 | wbplayerstruct_t = record 150 | _in: boolean; // whether the player is in game 151 | 152 | // Player stats, kills, collected items etc. 153 | skills: integer; 154 | sitems: integer; 155 | ssecret: integer; 156 | stime: integer; 157 | frags: array[0..MAXPLAYERS - 1] of integer; 158 | end; 159 | Pwbplayerstruct_t = ^wbplayerstruct_t; 160 | wbplayerstruct_tArray = packed array[0..$FFFF] of wbplayerstruct_t; 161 | Pwbplayerstruct_tArray = ^wbplayerstruct_tArray; 162 | 163 | wbstartstruct_t = record 164 | epsd: integer; // episode # (0-2) 165 | 166 | // if True, splash the secret level 167 | didsecret: boolean; 168 | 169 | // previous and next levels, origin 0 170 | last: integer; 171 | next: integer; 172 | 173 | maxkills: integer; 174 | maxitems: integer; 175 | maxsecret: integer; 176 | maxfrags: integer; 177 | 178 | // the par time 179 | partime: integer; 180 | 181 | // index of this player in game 182 | pnum: integer; 183 | 184 | plyr: array[0..MAXPLAYERS - 1] of wbplayerstruct_t; 185 | end; 186 | Pwbstartstruct_t = ^wbstartstruct_t; 187 | 188 | var 189 | players: array[0..MAXPLAYERS - 1] of player_t; 190 | 191 | implementation 192 | 193 | end. 194 | -------------------------------------------------------------------------------- /doomdata.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit doomdata; 28 | 29 | interface 30 | 31 | uses 32 | // char8_t 33 | w_wad; 34 | 35 | type 36 | 37 | // Map level types. 38 | // The following data structures define the persistent format 39 | // used in the lumps of the WAD files. 40 | 41 | 42 | // Lump order in a map WAD: each map needs a couple of lumps 43 | // to provide a complete scene geometry description. 44 | maplumpdesc_t = ( 45 | ML_LABEL, // A separator, name, ExMx or MAPxx 46 | ML_THINGS, // Monsters, items.. 47 | ML_LINEDEFS, // LineDefs, from editing 48 | ML_SIDEDEFS, // SideDefs, from editing 49 | ML_VERTEXES, // Vertices, edited and BSP splits generated 50 | ML_SEGS, // LineSegs, from LineDefs split by BSP 51 | ML_SSECTORS, // SubSectors, list of LineSegs 52 | ML_NODES, // BSP nodes 53 | ML_SECTORS, // Sectors, from editing 54 | ML_REJECT, // LUT, sector-sector visibility 55 | ML_BLOCKMAP // LUT, motion clipping, walls/grid element 56 | ); 57 | 58 | mapvertex_t = record 59 | x: smallint; 60 | y: smallint; 61 | end; 62 | Pmapvertex_t = ^mapvertex_t; 63 | 64 | // A SideDef, defining the visual appearance of a wall, 65 | // by setting textures and offsets. 66 | mapsidedef_t = record 67 | textureoffset: smallint; 68 | rowoffset: smallint; 69 | toptexture: char8_t; 70 | bottomtexture: char8_t; 71 | midtexture: char8_t; 72 | // Front sector, towards viewer. 73 | sector: smallint; 74 | end; 75 | Pmapsidedef_t = ^mapsidedef_t; 76 | 77 | // A LineDef, as used for editing, and as input 78 | // to the BSP builder. 79 | maplinedef_t = record 80 | v1: smallint; 81 | v2: smallint; 82 | flags: smallint; 83 | special: smallint; 84 | tag: smallint; 85 | // sidenum[1] will be -1 if one sided 86 | sidenum: array[0..1] of smallint; 87 | end; 88 | Pmaplinedef_t = ^maplinedef_t; 89 | 90 | // LineDef attributes. 91 | 92 | const 93 | // Solid, is an obstacle. 94 | ML_BLOCKING = 1; 95 | 96 | // Blocks monsters only. 97 | ML_BLOCKMONSTERS = 2; 98 | 99 | // Backside will not be present at all 100 | // if not two sided. 101 | ML_TWOSIDED = 4; 102 | 103 | // If a texture is pegged, the texture will have 104 | // the end exposed to air held constant at the 105 | // top or bottom of the texture (stairs or pulled 106 | // down things) and will move with a height change 107 | // of one of the neighbor sectors. 108 | // Unpegged textures allways have the first row of 109 | // the texture at the top pixel of the line for both 110 | // top and bottom textures (use next to windows). 111 | 112 | // upper texture unpegged 113 | ML_DONTPEGTOP = 8; 114 | 115 | // lower texture unpegged 116 | ML_DONTPEGBOTTOM = 16; 117 | 118 | // In AutoMap: don't map as two sided: IT'S A SECRET! 119 | ML_SECRET = 32; 120 | 121 | // Sound rendering: don't let sound cross two of these. 122 | ML_SOUNDBLOCK = 64; 123 | 124 | // Don't draw on the automap at all. 125 | ML_DONTDRAW = 128; 126 | 127 | // Set if already seen, thus drawn in automap. 128 | ML_MAPPED = 256; 129 | 130 | 131 | type 132 | // Sector definition, from editing. 133 | mapsector_t = record 134 | floorheight: smallint; 135 | ceilingheight: smallint; 136 | floorpic: char8_t; 137 | ceilingpic: char8_t; 138 | lightlevel: smallint; 139 | special: smallint; 140 | tag: smallint; 141 | end; 142 | Pmapsector_t = ^mapsector_t; 143 | 144 | // SubSector, as generated by BSP. 145 | mapsubsector_t = record 146 | numsegs: smallint; 147 | // Index of first one, segs are stored sequentially. 148 | firstseg: smallint; 149 | end; 150 | Pmapsubsector_t = ^mapsubsector_t; 151 | 152 | // LineSeg, generated by splitting LineDefs 153 | // using partition lines selected by BSP builder. 154 | mapseg_t = record 155 | v1: smallint; 156 | v2: smallint; 157 | angle: smallint; 158 | linedef: smallint; 159 | side: smallint; 160 | offset: smallint; 161 | end; 162 | Pmapseg_t = ^mapseg_t; 163 | 164 | // BSP node structure. 165 | 166 | // Indicate a leaf. 167 | const 168 | NF_SUBSECTOR = $8000; 169 | 170 | type 171 | mapnode_t = record 172 | // Partition line from (x,y) to x+dx,y+dy) 173 | x: smallint; 174 | y: smallint; 175 | dx: smallint; 176 | dy: smallint; 177 | 178 | // Bounding box for each child, 179 | // clip against view frustum. 180 | bbox: packed array[0..1] of packed array[0..3] of smallint; 181 | 182 | // If NF_SUBSECTOR its a subsector, 183 | // else it's a node of another subtree. 184 | children: packed array[0..1] of word; 185 | end; 186 | Pmapnode_t = ^mapnode_t; 187 | 188 | // Thing definition, position, orientation and type, 189 | // plus skill/visibility flags and attributes. 190 | mapthing_t = record 191 | x: smallint; 192 | y: smallint; 193 | angle: smallint; 194 | typ: smallint; 195 | options: smallint; 196 | end; 197 | Pmapthing_t = ^mapthing_t; 198 | 199 | implementation 200 | 201 | end. 202 | -------------------------------------------------------------------------------- /p_mobj_h.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_mobj_h; 28 | 29 | interface 30 | 31 | uses 32 | m_fixed, 33 | info_h, 34 | doomdata, 35 | tables, 36 | d_think; 37 | 38 | const 39 | // Call P_SpecialThing when touched. 40 | MF_SPECIAL = 1; 41 | // Blocks. 42 | MF_SOLID = 2; 43 | // Can be hit. 44 | MF_SHOOTABLE = 4; 45 | // Don't use the sector links (invisible but touchable). 46 | MF_NOSECTOR = 8; 47 | // Don't use the blocklinks (inert but displayable) 48 | MF_NOBLOCKMAP = 16; 49 | 50 | // Not to be activated by sound, deaf monster. 51 | MF_AMBUSH = 32; 52 | // Will try to attack right back. 53 | MF_JUSTHIT = 64; 54 | // Will take at least one step before attacking. 55 | MF_JUSTATTACKED = 128; 56 | // On level spawning (initial position), 57 | // hang from ceiling instead of stand on floor. 58 | MF_SPAWNCEILING = 256; 59 | // Don't apply gravity (every tic), 60 | // that is, object will float, keeping current height 61 | // or changing it actively. 62 | MF_NOGRAVITY = 512; 63 | 64 | // Movement flags. 65 | // This allows jumps from high places. 66 | MF_DROPOFF = $400; 67 | // For players, will pick up items. 68 | MF_PICKUP = $800; 69 | // Player cheat. ??? 70 | MF_NOCLIP = $1000; 71 | // Player: keep info about sliding along walls. 72 | MF_SLIDE = $2000; 73 | // Allow moves to any height, no gravity. 74 | // For active floaters, e.g. cacodemons, pain elementals. 75 | MF_FLOAT = $4000; 76 | // Don't cross lines 77 | // ??? or look at heights on teleport. 78 | MF_TELEPORT = $8000; 79 | // Don't hit same species, explode on block. 80 | // Player missiles as well as fireballs of various kinds. 81 | MF_MISSILE = $10000; 82 | // Dropped by a demon, not level spawned. 83 | // E.g. ammo clips dropped by dying former humans. 84 | MF_DROPPED = $20000; 85 | // Use fuzzy draw (shadow demons or spectres), 86 | // temporary player invisibility powerup. 87 | MF_SHADOW = $40000; 88 | // Flag: don't bleed when shot (use puff), 89 | // barrels and shootable furniture shall not bleed. 90 | MF_NOBLOOD = $80000; 91 | // Don't stop moving halfway off a step, 92 | // that is, have dead bodies slide down all the way. 93 | MF_CORPSE = $100000; 94 | // Floating to a height for a move, ??? 95 | // don't auto float to target's height. 96 | MF_INFLOAT = $200000; 97 | 98 | // On kill, count this enemy object 99 | // towards intermission kill total. 100 | // Happy gathering. 101 | MF_COUNTKILL = $400000; 102 | 103 | // On picking up, count this item object 104 | // towards intermission item total. 105 | MF_COUNTITEM = $800000; 106 | 107 | // Special handling: skull in flight. 108 | // Neither a cacodemon nor a missile. 109 | MF_SKULLFLY = $1000000; 110 | 111 | // Don't spawn this object 112 | // in death match mode (e.g. key cards). 113 | MF_NOTDMATCH = $2000000; 114 | 115 | // Player sprites in multiplayer modes are modified 116 | // using an internal color lookup table for re-indexing. 117 | // If 0x4 0x8 or 0xc, 118 | // use a translation table for player colormaps 119 | MF_TRANSLATION = $c000000; 120 | // Hmm ???. 121 | MF_TRANSSHIFT = 26; 122 | 123 | type 124 | // Map Object definition. 125 | Pmobj_t = ^mobj_t; 126 | 127 | mobj_t = record 128 | // List: thinker links. 129 | thinker: thinker_t; 130 | // Info for drawing: position. 131 | x: fixed_t; 132 | y: fixed_t; 133 | z: fixed_t; 134 | // More list: links in sector (if needed) 135 | snext: Pmobj_t; 136 | sprev: Pmobj_t; 137 | //More drawing info: to determine current sprite. 138 | angle: angle_t; // orientation 139 | sprite: spritenum_t; // used to find patch_t and flip value 140 | frame: integer; // might be ORed with FF_FULLBRIGHT 141 | // Interaction info, by BLOCKMAP. 142 | // Links in blocks (if needed). 143 | bnext: Pmobj_t; 144 | bprev: Pmobj_t; 145 | subsector: pointer; //Psubsector_t; 146 | // The closest interval over all contacted Sectors. 147 | floorz: fixed_t; 148 | ceilingz: fixed_t; 149 | // For movement checking. 150 | radius: fixed_t; 151 | height: fixed_t; 152 | // Momentums, used to update position. 153 | momx: fixed_t; 154 | momy: fixed_t; 155 | momz: fixed_t; 156 | // If == validcount, already checked. 157 | validcount: integer; 158 | typ: mobjtype_t; 159 | info: Pmobjinfo_t; // &mobjinfo[mobj->type] 160 | tics: integer; // state tic counter 161 | state: Pstate_t; 162 | flags: integer; 163 | health: integer; 164 | // Movement direction, movement generation (zig-zagging). 165 | movedir: integer; // 0-7 166 | movecount: integer; // when 0, select a new dir 167 | // Thing being chased/attacked (or NULL), 168 | // also the originator for missiles. 169 | target: Pmobj_t; 170 | // Reaction time: if non 0, don't attack yet. 171 | // Used by player to freeze a bit after teleporting. 172 | reactiontime: integer; 173 | // If >0, the target will be chased 174 | // no matter what (even if shot) 175 | threshold: integer; 176 | // Additional info record for player avatars only. 177 | // Only valid if type == MT_PLAYER 178 | player: pointer; //Pplayer_t; 179 | // Player number last looked for. 180 | lastlook: integer; 181 | // For nightmare respawn. 182 | spawnpoint: mapthing_t; 183 | // Thing being chased/attacked for tracers. 184 | tracer: Pmobj_t; 185 | end; 186 | Tmobj_tPArray = array[0..$FFFF] of Pmobj_t; 187 | Pmobj_tPArray = ^Tmobj_tPArray; 188 | 189 | implementation 190 | 191 | end. 192 | -------------------------------------------------------------------------------- /i_video.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit i_video; 28 | 29 | interface 30 | 31 | uses 32 | Windows, 33 | d_delphi; 34 | 35 | // Called by D_DoomMain, 36 | // determines the hardware configuration 37 | // and sets up the video mode 38 | procedure I_InitGraphics; 39 | 40 | procedure I_ShutDownGraphics; 41 | 42 | // Takes full 8 bit values. 43 | procedure I_SetPalette(palette: PByteArray); 44 | 45 | procedure I_FinishUpdate; 46 | 47 | procedure I_ReadScreen(scr: PByteArray); 48 | 49 | function I_NativeWidth: integer; 50 | 51 | function I_NativeHeight: integer; 52 | 53 | var 54 | fullscreen: boolean = True; 55 | 56 | implementation 57 | 58 | uses 59 | doomdef, 60 | DirectDraw, 61 | i_system, 62 | i_main, 63 | v_video; 64 | 65 | var 66 | curpal: array[0..255] of LongWord; 67 | g_pDD: IDirectDraw7 = nil; // DirectDraw object 68 | g_pDDSPrimary: IDirectDrawSurface7 = nil;// DirectDraw primary surface 69 | g_pDDScreen: IDirectDrawSurface7 = nil; // DirectDraw surface 70 | screen32: array[0..SCREENWIDTH * SCREENHEIGHT - 1] of LongWord; 71 | 72 | procedure I_ShutdownGraphics; 73 | begin 74 | I_ClearInterface(IInterface(g_pDDSPrimary)); 75 | I_ClearInterface(IInterface(g_pDDScreen)); 76 | I_ClearInterface(IInterface(g_pDD)); 77 | end; 78 | 79 | function I_NativeWidth: integer; 80 | begin 81 | Result := GetSystemMetrics(SM_CXSCREEN); 82 | end; 83 | 84 | function I_NativeHeight: integer; 85 | begin 86 | Result := GetSystemMetrics(SM_CYSCREEN); 87 | end; 88 | 89 | 90 | // I_FinishUpdate 91 | procedure I_FinishUpdate; 92 | var 93 | i: integer; 94 | srcrect: TRect; 95 | destrect: TRect; 96 | dest: PLongWord; 97 | src: PByte; 98 | begin 99 | if hMainWnd = 0 then 100 | Exit; 101 | if screens[SCN_FG] = nil then 102 | Exit; 103 | 104 | begin 105 | dest := @screen32; 106 | src := @(screens[SCN_FG]^); 107 | for i := 0 to SCREENWIDTH * SCREENHEIGHT - 1 do 108 | begin 109 | dest^ := curpal[src^]; 110 | Inc(dest); 111 | Inc(src); 112 | end; 113 | end; 114 | 115 | srcrect.Left := 0; 116 | srcrect.Top := 0; 117 | srcrect.Right := SCREENWIDTH; 118 | srcrect.Bottom := SCREENHEIGHT; 119 | 120 | destrect.Left := 0; 121 | destrect.Top := 0; 122 | if fullscreen then 123 | begin 124 | destrect.Right := I_NativeWidth; 125 | destrect.Bottom := I_NativeHeight; 126 | end 127 | else 128 | begin 129 | destrect.Right := SCREENWIDTH; 130 | destrect.Bottom := SCREENHEIGHT; 131 | end; 132 | if g_pDDSPrimary.Blt(@destrect, g_pDDScreen, @srcrect, DDBLTFAST_WAIT or DDBLTFAST_NOCOLORKEY, nil) = DDERR_SURFACELOST then 133 | g_pDDSPrimary._Restore; 134 | end; 135 | 136 | 137 | // Palette stuff. 138 | 139 | // I_SetPalette 140 | procedure I_SetPalette(palette: PByteArray); 141 | var 142 | dest: PLongWord; 143 | src: PByteArray; 144 | begin 145 | dest := @curpal[0]; 146 | src := palette; 147 | while integer(src) < integer(@palette[256 * 3]) do 148 | begin 149 | dest^ := (LongWord(gammatable[usegamma, src[0]]) shl 16) or 150 | (LongWord(gammatable[usegamma, src[1]]) shl 8) or 151 | (LongWord(gammatable[usegamma, src[2]])); 152 | Inc(dest); 153 | incp(pointer(src), 3); 154 | end; 155 | end; 156 | 157 | // Called by D_DoomMain, 158 | // determines the hardware configuration 159 | // and sets up the video mode 160 | procedure I_InitGraphics; 161 | var 162 | hres: HRESULT; 163 | ddsd: DDSURFACEDESC2; 164 | 165 | procedure I_ErrorInitGraphics(const proc: string); 166 | begin 167 | I_Error('I_InitGraphics(): %s failed, Result = %d', [proc, hres]); 168 | end; 169 | 170 | begin 171 | if g_pDD <> nil then 172 | Exit; 173 | /////////////////////////////////////////////////////////////////////////// 174 | // Create the main DirectDraw object 175 | /////////////////////////////////////////////////////////////////////////// 176 | hres := DirectDrawCreateEx(nil, g_pDD, IID_IDirectDraw7, nil); 177 | if hres <> DD_OK then 178 | I_ErrorInitGraphics('DirectDrawCreateEx'); 179 | 180 | if fullscreen then 181 | SetWindowPos(hMainWnd, 0, 0, 0, I_NativeWidth, I_NativeHeight, SWP_SHOWWINDOW) 182 | else 183 | SetWindowPos(hMainWnd, 0, 0, 0, SCREENWIDTH, SCREENHEIGHT, SWP_SHOWWINDOW); 184 | 185 | hres := g_pDD.SetCooperativeLevel(hMainWnd, DDSCL_NORMAL); 186 | if hres <> DD_OK then 187 | I_ErrorInitGraphics('SetCooperativeLevel'); 188 | 189 | ZeroMemory(@ddsd, SizeOf(ddsd)); 190 | ddsd.dwSize := SizeOf(ddsd); 191 | ddsd.dwFlags := DDSD_CAPS; 192 | ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_VIDEOMEMORY; 193 | hres := g_pDD.CreateSurface(ddsd, g_pDDSPrimary, nil); 194 | if hres <> DD_OK then 195 | I_ErrorInitGraphics('CreateSurface'); 196 | 197 | ZeroMemory(@ddsd, SizeOf(ddsd)); 198 | ZeroMemory(@ddsd.ddpfPixelFormat, SizeOf(ddsd.ddpfPixelFormat)); 199 | 200 | ddsd.ddpfPixelFormat.dwSize := SizeOf(ddsd.ddpfPixelFormat); 201 | g_pDDSPrimary.GetPixelFormat(ddsd.ddpfPixelFormat); 202 | 203 | ddsd.dwSize := SizeOf(ddsd); 204 | ddsd.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_LPSURFACE or 205 | DDSD_PITCH or DDSD_PIXELFORMAT or DDSD_CAPS; 206 | ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN or DDSCAPS_SYSTEMMEMORY; 207 | 208 | ddsd.dwWidth := SCREENWIDTH; 209 | ddsd.dwHeight := SCREENHEIGHT; 210 | ddsd.lPitch := 4 * SCREENWIDTH; // Display is True color 211 | ddsd.lpSurface := @screen32; 212 | 213 | hres := g_pDD.CreateSurface(ddsd, g_pDDScreen, nil); 214 | if hres <> DD_OK then 215 | I_ErrorInitGraphics('CreateSurface'); 216 | end; 217 | 218 | procedure I_ReadScreen(scr: PByteArray); 219 | begin 220 | memcpy(scr, screens[SCN_FG], SCREENWIDTH * SCREENHEIGHT); 221 | end; 222 | 223 | end. 224 | -------------------------------------------------------------------------------- /i_midi.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit i_midi; 28 | 29 | interface 30 | 31 | procedure I_PlayMidi; 32 | 33 | procedure I_StopMidi; 34 | 35 | procedure AddMidiFileToPlayList(MidiFile: string); 36 | 37 | function I_IsMidiPlaying: boolean; 38 | 39 | procedure I_ResumeMidi; 40 | 41 | procedure I_PauseMidi; 42 | 43 | function _mciGetErrorString(const code: LongWord): string; 44 | 45 | var 46 | MidiFileName: string; 47 | 48 | implementation 49 | 50 | uses 51 | d_delphi, 52 | Windows, 53 | Messages, 54 | MMSystem; 55 | 56 | var 57 | wDeviceID: DWORD; 58 | Window: HWnd; 59 | fIsPlaying: boolean; 60 | WindowClass: TWndClass; 61 | 62 | const 63 | rsAppName = 'MIDIPLAYERWNDNOTIFY'; 64 | rsSequencer = 'sequencer'; 65 | rsWndTitle = 'Notify Window'; 66 | rsErrNoMIDIMapper = 'MIDI mapper unavailable'; 67 | 68 | // Plays a specified MIDI file by using MCI_OPEN and MCI_PLAY. Returns 69 | // as soon as playback begins. The window procedure function for the 70 | // specified window will be notified when playback is complete. 71 | // Returns 0L on success; otherwise, it returns an MCI error code. 72 | function playMIDIFile(hWndNotify: HWnd; lpszMIDIFileName: string; 73 | doCheckMidiMapper: boolean = False): DWORD; 74 | var 75 | mciOpenParms: MCI_OPEN_PARMS; 76 | mciPlayParms: MCI_PLAY_PARMS; 77 | mciStatusParms: MCI_STATUS_PARMS; 78 | begin 79 | // Open the device by specifying the device and filename. 80 | // MCI will attempt to choose the MIDI mapper as the output port. 81 | FillChar(mciOpenParms, SizeOf(mciOpenParms), Chr(0)); 82 | mciOpenParms.lpstrDeviceType := PAnsiChar(rssequencer); 83 | mciOpenParms.lpstrElementName := PChar(lpszMIDIFileName); 84 | Result := mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, 85 | DWORD(@mciOpenParms)); 86 | // Failed to open device. Don't close it; just return error. 87 | if Result <> 0 then 88 | Exit; 89 | 90 | // The device opened successfully; get the device ID. 91 | wDeviceID := mciOpenParms.wDeviceID; 92 | 93 | if doCheckMidiMapper then 94 | begin 95 | // Check if the output port is the MIDI mapper. 96 | mciStatusParms.dwItem := MCI_SEQ_STATUS_PORT; 97 | Result := mciSendCommand(wDeviceID, MCI_STATUS, MCI_STATUS_ITEM, 98 | DWORD(@mciStatusParms)); 99 | if Result <> 0 then 100 | begin 101 | mciSendCommand(wDeviceID, MCI_CLOSE, 0, 0); 102 | Exit; 103 | end 104 | else if LOWORD(mciStatusParms.dwReturn) <> word(MIDI_MAPPER) then 105 | // The output port is not the MIDI mapper. 106 | begin 107 | printf(rsErrNoMIDIMapper); 108 | Exit; 109 | end; 110 | end; 111 | 112 | // Begin playback. The window procedure function for the parent 113 | // window will be notified with an MM_MCINOTIFY message when 114 | // playback is complete. At this time, the window procedure closes 115 | // the device. 116 | FillChar(mciPlayParms, SizeOf(mciPlayParms), Chr(0)); 117 | mciPlayParms.dwCallback := DWORD(hWndNotify); 118 | Result := mciSendCommand(wDeviceID, MCI_PLAY, MCI_NOTIFY, DWORD(@mciPlayParms)); 119 | if Result > 0 then 120 | mciSendCommand(wDeviceID, MCI_CLOSE, 0, 0); 121 | end; 122 | 123 | procedure StopPlaying; 124 | begin 125 | mciSendCommand(wDeviceID, MCI_STOP, 0, 0); 126 | mciSendCommand(wDeviceID, MCI_CLOSE, 0, 0); 127 | end; 128 | 129 | function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; 130 | stdcall; export; 131 | begin 132 | Result := 0; 133 | case Msg of 134 | MM_MCINOTIFY: 135 | if wParam = MCI_NOTIFY_SUCCESSFUL then 136 | begin 137 | StopPlaying; 138 | playMIDIFile(Window, MidiFileName); 139 | end; 140 | WM_CLOSE: 141 | begin 142 | DestroyWindow(hWnd); 143 | Window := 0; 144 | Exit; 145 | end; 146 | end; 147 | Result := DefWindowProc(hWnd, Msg, WParam, LParam); 148 | end; 149 | 150 | procedure AddMidiFileToPlayList(MidiFile: string); 151 | begin 152 | MidiFileName := MidiFile; 153 | end; 154 | 155 | procedure I_PlayMidi; 156 | begin 157 | I_StopMidi; 158 | FillChar(WindowClass, SizeOf(WindowClass), Chr(0)); 159 | if Window = 0 then 160 | begin 161 | WindowClass.style := CS_DBLCLKS; 162 | WindowClass.lpfnWndProc := @WindowProc; 163 | WindowClass.lpszClassName := PChar(rsAppName); 164 | if HPrevInst = 0 then 165 | begin 166 | WindowClass.hInstance := HInstance; 167 | WindowClass.hCursor := LoadCursor(0, idc_Arrow); 168 | RegisterClass(WindowClass); 169 | end; 170 | Window := CreateWindowEx(0, WindowClass.lpszClassName, 171 | PChar(rsWndTitle), ws_OverlappedWindow, integer(CW_USEDEFAULT), 172 | integer(CW_USEDEFAULT), integer(CW_USEDEFAULT), 173 | integer(CW_USEDEFAULT), 0, 0, HInstance, nil); 174 | ShowWindow(Window, SW_HIDE); 175 | end; 176 | 177 | playMIDIFile(Window, MidiFileName, True); 178 | end; 179 | 180 | procedure I_StopMidi; 181 | begin 182 | if Window <> 0 then 183 | begin 184 | StopPlaying; 185 | SendMessage(Window, WM_CLOSE, 0, 0); 186 | Window := 0; 187 | fIsPlaying := False; 188 | end; 189 | end; 190 | 191 | function I_IsMidiPlaying: boolean; 192 | begin 193 | Result := fIsPlaying; 194 | end; 195 | 196 | procedure I_ResumeMidi; 197 | begin 198 | mciSendCommand(wDeviceID, MCI_RESUME, 0, 0); 199 | end; 200 | 201 | procedure I_PauseMidi; 202 | begin 203 | mciSendCommand(wDeviceID, MCI_PAUSE, 0, 0); 204 | end; 205 | 206 | function _mciGetErrorString(const code: LongWord): string; 207 | var 208 | buf: array[0..127] of char; 209 | i: integer; 210 | begin 211 | Result := ''; 212 | FillChar(buf, 128, Chr(0)); 213 | if mciGetErrorString(code, buf, 128) then 214 | for i := 0 to 127 do 215 | begin 216 | if buf[i] = #0 then 217 | Break; 218 | Result := Result + buf[i]; 219 | end; 220 | end; 221 | 222 | initialization 223 | Window := 0; 224 | fIsPlaying := False; 225 | 226 | finalization 227 | StopPlaying; 228 | 229 | end. 230 | 231 | -------------------------------------------------------------------------------- /r_intrpl.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit r_intrpl; 28 | 29 | // JVAL 30 | // Frame interpolation to exceed the 35fps limit 31 | // 32 | 33 | interface 34 | 35 | procedure R_ResetInterpolationBuffer; 36 | 37 | procedure R_StoreInterpolationData; 38 | 39 | procedure R_RestoreInterpolationData; 40 | 41 | function R_Interpolate: boolean; 42 | 43 | var 44 | interpolationstarttime: int64; 45 | 46 | implementation 47 | 48 | uses 49 | d_delphi, 50 | d_player, 51 | d_think, 52 | g_game, 53 | i_system, 54 | m_fixed, 55 | p_setup, 56 | p_tick, 57 | p_mobj, 58 | p_mobj_h, 59 | p_pspr_h, 60 | r_defs, 61 | z_memory; 62 | 63 | type 64 | // Interpolation item 65 | // Holds information about the previous and next values 66 | iitem_t = record 67 | lastaddress: PInteger; 68 | address: PInteger; 69 | iprev, inext: integer; 70 | end; 71 | Piitem_t = ^iitem_t; 72 | iitem_tArray = array[0..$FFFF] of iitem_t; 73 | Piitem_tArray = ^iitem_tArray; 74 | 75 | // Interpolation structure 76 | // Holds the global interpolation items list 77 | istruct_t = record 78 | numitems: integer; 79 | realsize: integer; 80 | items: Piitem_tArray; 81 | end; 82 | 83 | const 84 | IGROWSTEP = 256; 85 | 86 | var 87 | istruct: istruct_t; 88 | ffrac: single; 89 | 90 | procedure R_ResetInterpolationBuffer; 91 | begin 92 | if istruct.items <> nil then 93 | Z_Free(istruct.items); 94 | istruct.items := nil; 95 | istruct.numitems := 0; 96 | istruct.realsize := 0; 97 | end; 98 | 99 | const 100 | DIFF_THRESHOLD = 32 * FRACUNIT; 101 | 102 | procedure R_InterpolationCalcI(const pi: Piitem_t; const thres: integer = DIFF_THRESHOLD); 103 | var 104 | diff: integer; 105 | begin 106 | diff := pi.inext - pi.iprev; 107 | if Abs(diff) > thres then 108 | exit; 109 | if diff <> 0 then 110 | pi.address^ := pi.iprev + Round(diff * ffrac); 111 | end; 112 | 113 | procedure R_AddInterpolationItem(const addr: PInteger); 114 | var 115 | newrealsize: integer; 116 | pi: Piitem_t; 117 | begin 118 | if istruct.realsize <= istruct.numitems then 119 | begin 120 | newrealsize := istruct.realsize + IGROWSTEP; 121 | istruct.items := Z_Realloc(istruct.items, newrealsize * SizeOf(iitem_t), PU_STATIC, nil); 122 | ZeroMemory(@istruct.items[istruct.realsize], IGROWSTEP * SizeOf(iitem_t)); 123 | istruct.realsize := newrealsize; 124 | end; 125 | pi := @istruct.items[istruct.numitems]; 126 | pi.lastaddress := pi.address; 127 | pi.address := addr; 128 | pi.iprev := pi.inext; 129 | pi.inext := addr^; 130 | inc(istruct.numitems); 131 | end; 132 | 133 | procedure R_StoreInterpolationData; 134 | var 135 | sec: Psector_t; 136 | li: Pline_t; 137 | si: PSide_t; 138 | i, j: integer; 139 | player: Pplayer_t; 140 | pmo: Pmobj_t; 141 | th: Pthinker_t; 142 | begin 143 | istruct.numitems := 0; 144 | 145 | // Interpolate player 146 | player := @players[displayplayer]; 147 | pmo := player.mo; 148 | R_AddInterpolationItem(@pmo.angle); 149 | R_AddInterpolationItem(@pmo.x); 150 | R_AddInterpolationItem(@pmo.y); 151 | R_AddInterpolationItem(@pmo.z); 152 | R_AddInterpolationItem(@player.viewz); 153 | for i := 0 to Ord(NUMPSPRITES) - 1 do 154 | begin 155 | R_AddInterpolationItem(@player.psprites[i].sx); 156 | R_AddInterpolationItem(@player.psprites[i].sy); 157 | end; 158 | 159 | // Interpolate Sectors 160 | sec := @sectors[0]; 161 | for i := 0 to numsectors - 1 do 162 | begin 163 | R_AddInterpolationItem(@sec.floorheight); 164 | R_AddInterpolationItem(@sec.ceilingheight); 165 | inc(sec); 166 | end; 167 | 168 | // Interpolate Lines 169 | li := @lines[0]; 170 | for i := 0 to numlines - 1 do 171 | begin 172 | for j := 0 to 1 do 173 | begin 174 | if li.sidenum[j] > -1 then 175 | begin 176 | si := @sides[li.sidenum[j]]; 177 | R_AddInterpolationItem(@si.textureoffset); 178 | R_AddInterpolationItem(@si.rowoffset); 179 | end; 180 | end; 181 | inc(li); 182 | end; 183 | 184 | // Map Objects 185 | th := thinkercap.next; 186 | while (th <> nil) and (th <> @thinkercap) do 187 | begin 188 | if @th.func.acp1 = @P_MobjThinker then 189 | if Pmobj_t(th) <> pmo then 190 | begin 191 | R_AddInterpolationItem(@Pmobj_t(th).x); 192 | R_AddInterpolationItem(@Pmobj_t(th).y); 193 | R_AddInterpolationItem(@Pmobj_t(th).z); 194 | end; 195 | th := th.next; 196 | end; 197 | end; 198 | 199 | procedure R_RestoreInterpolationData; 200 | var 201 | i: integer; 202 | pi: Piitem_t; 203 | begin 204 | pi := @istruct.items[0]; 205 | for i := 0 to istruct.numitems - 1 do 206 | begin 207 | pi.address^ := pi.inext; 208 | inc(pi); 209 | end; 210 | istruct.numitems := 0; 211 | end; 212 | 213 | function R_Interpolate: boolean; 214 | var 215 | i: integer; 216 | pi: Piitem_t; 217 | begin 218 | ffrac := (I_GetTime64 - interpolationstarttime) / FRACUNIT; 219 | if ffrac >= 1.0 then 220 | begin 221 | Result := False; 222 | Exit; 223 | end; 224 | 225 | Result := True; 226 | // Prevent player teleport interpolation 227 | if (istruct.items[1].lastaddress = istruct.items[1].address) and 228 | (istruct.items[2].lastaddress = istruct.items[2].address) and 229 | (istruct.items[3].lastaddress = istruct.items[3].address) then 230 | begin 231 | if (Abs(istruct.items[1].iprev - istruct.items[1].inext) < DIFF_THRESHOLD) and 232 | (Abs(istruct.items[2].iprev - istruct.items[2].inext) < DIFF_THRESHOLD) and 233 | (Abs(istruct.items[3].iprev - istruct.items[3].inext) < DIFF_THRESHOLD) then 234 | begin 235 | R_InterpolationCalcI(@istruct.items[0], MAXINT); 236 | R_InterpolationCalcI(@istruct.items[1]); 237 | R_InterpolationCalcI(@istruct.items[2]); 238 | R_InterpolationCalcI(@istruct.items[3]); 239 | R_InterpolationCalcI(@istruct.items[4]); 240 | end; 241 | end; 242 | pi := @istruct.items[5]; 243 | for i := 5 to istruct.numitems - 1 do 244 | begin 245 | if pi.address = pi.lastaddress then 246 | R_InterpolationCalcI(pi); 247 | inc(pi); 248 | end; 249 | end; 250 | 251 | end. 252 | 253 | -------------------------------------------------------------------------------- /i_net.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit i_net; 28 | 29 | interface 30 | 31 | procedure I_InitNetwork; 32 | 33 | procedure I_NetCmd; 34 | 35 | implementation 36 | 37 | uses 38 | WinSock, 39 | d_delphi, 40 | d_net, 41 | i_system, 42 | g_game, 43 | m_argv; 44 | 45 | var 46 | netget: PProcedure; 47 | netsend: PProcedure; 48 | 49 | const 50 | IPPORT_USERRESERVED = 5000; 51 | 52 | var 53 | DOOMPORT: integer = (IPPORT_USERRESERVED + $1d); 54 | sendsocket: TSocket; 55 | insocket: TSocket; 56 | sendaddress: array[0..MAXNETNODES - 1] of TSockAddrIn; 57 | 58 | // UDPsocket 59 | function UDPsocket: TSocket; 60 | begin 61 | // allocate a socket 62 | Result := socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP); 63 | if Result = INVALID_SOCKET then 64 | I_Error('UDPsocket(): Can''t create socket: Result = %d'#13#10, [Result]); 65 | end; 66 | 67 | // BindToLocalPort 68 | procedure BindToLocalPort(s: integer; port: integer); 69 | var 70 | v: integer; 71 | address: TSockAddrIn; 72 | begin 73 | ZeroMemory(@address, SizeOf(address)); 74 | address.sin_family := AF_INET; 75 | address.sin_addr.s_addr := INADDR_ANY; 76 | address.sin_port := port; 77 | 78 | v := bind(s, address, SizeOf(address)); 79 | if v = -1 then 80 | I_Error('BindToLocalPort(): Failed.'); 81 | end; 82 | 83 | // PacketSend 84 | procedure PacketSend; 85 | var 86 | c: integer; 87 | begin 88 | c := sendto(sendsocket, netbuffer^, doomcom.datalength, 0, 89 | sendaddress[doomcom.remotenode], SizeOf(sendaddress[doomcom.remotenode])); 90 | 91 | if c = SOCKET_ERROR then 92 | I_Error('PacketSend(): sendto() failed.'); 93 | end; 94 | 95 | // PacketGet 96 | procedure PacketGet; 97 | var 98 | i: integer; 99 | c: integer; 100 | fromaddress: TSockAddrIn; 101 | fromlen: integer; 102 | begin 103 | fromlen := SizeOf(fromaddress); 104 | c := recvfrom(insocket, netbuffer^, SizeOf(doomdata_t), 0, fromaddress, fromlen); 105 | if c = SOCKET_ERROR then 106 | begin 107 | c := WSAGetLastError; 108 | if c <> WSAEWOULDBLOCK then 109 | I_Error('PacketGet(): Network error.'); 110 | doomcom.remotenode := -1; // no packet 111 | Exit; 112 | end; 113 | 114 | // find remote node number 115 | i := 0; 116 | while i < doomcom.numnodes do 117 | begin 118 | if fromaddress.sin_addr.s_addr = sendaddress[i].sin_addr.s_addr then 119 | Break; 120 | inc(i); 121 | end; 122 | 123 | if i = doomcom.numnodes then 124 | begin 125 | // packet is not from one of the players (new game broadcast) 126 | doomcom.remotenode := -1; // no packet 127 | Exit; 128 | end; 129 | 130 | doomcom.remotenode := i; // good packet from a game player 131 | doomcom.datalength := c; 132 | end; 133 | 134 | // I_InitNetwork 135 | procedure I_InitNetwork; 136 | var 137 | trueval: integer; 138 | i, err: integer; 139 | p: integer; 140 | hostentry: PHostEnt; // host information entry 141 | wsadata: TWSAData; 142 | begin 143 | trueval := 1; 144 | ZeroMemory(@doomcom, SizeOf(doomcom_t)); 145 | 146 | // set up for network 147 | i := M_CheckParm('-dup'); 148 | if (i > 0) and (i < myargc - 1) then 149 | begin 150 | doomcom.ticdup := Ord(myargv[i + 1][1]) - Ord('0'); 151 | if doomcom.ticdup < 1 then 152 | doomcom.ticdup := 1 153 | else if doomcom.ticdup > 9 then 154 | doomcom.ticdup := 9; 155 | end 156 | else 157 | doomcom.ticdup := 1; 158 | 159 | if M_CheckParm('-extratic') > 0 then 160 | doomcom.extratics := 1 161 | else 162 | doomcom.extratics := 0; 163 | 164 | p := M_CheckParm('-port'); 165 | if (p > 0) and (p < myargc - 1) then 166 | begin 167 | DOOMPORT := atoi(myargv[p + 1]); 168 | printf('Using Port %d'#13#10, [DOOMPORT]); 169 | end; 170 | 171 | // parse network game options, 172 | // -net ... 173 | i := M_CheckParm('-net'); 174 | if i = 0 then 175 | begin 176 | // single player game 177 | netgame := False; 178 | doomcom.id := DOOMCOM_ID; 179 | doomcom.numplayers := 1; 180 | doomcom.numnodes := 1; 181 | doomcom.deathmatch := 0; 182 | doomcom.consoleplayer := 0; 183 | Exit; 184 | end; 185 | 186 | err := WSAStartup($0101, wsadata); 187 | if err <> 0 then 188 | I_Error('I_InitNetwork(): Could not initialize Windows Sockets, WSAStartup Result = %d', [err]); 189 | 190 | netsend := PacketSend; 191 | netget := PacketGet; 192 | netgame := True; 193 | 194 | // parse player number and host list 195 | doomcom.consoleplayer := Ord(myargv[i + 1][1]) - Ord('1'); 196 | printf('console player number: %d'#13#10, [doomcom.consoleplayer]); 197 | 198 | doomcom.numnodes := 1; // this node for sure 199 | 200 | inc(i); 201 | inc(i); 202 | while (i < myargc) and (myargv[i][1] <> '-') do 203 | begin 204 | sendaddress[doomcom.numnodes].sin_family := AF_INET; 205 | if myargv[i][1] = '.' then 206 | begin 207 | printf('Node number %d address %s'#13#10, [doomcom.numnodes, Copy(myargv[i], 2, Length(myargv[i]) - 1)]); 208 | sendaddress[doomcom.numnodes].sin_addr.s_addr := inet_addr(PChar(Copy(myargv[i], 2, Length(myargv[i]) - 1))); 209 | end 210 | else 211 | begin 212 | printf('Node number %d hostname %s'#13#10, [doomcom.numnodes, myargv[i]]); 213 | hostentry := gethostbyname(PChar(myargv[i])); 214 | if hostentry = nil then 215 | I_Error('gethostbyname(): couldn''t find %s', [myargv[i]]); 216 | sendaddress[doomcom.numnodes].sin_addr.s_addr := PInteger(hostentry.h_addr_list^)^; 217 | end; 218 | inc(i); 219 | if (i < myargc) and (myargv[i][1] = ':') then 220 | begin 221 | printf('Node number %d port %s'#13#10, [doomcom.numnodes, Copy(myargv[i], 2, Length(myargv[i]) - 1)]); 222 | sendaddress[doomcom.numnodes].sin_port := htons(atoi(Copy(myargv[i], 2, Length(myargv[i]) - 1))); 223 | inc(i); 224 | end 225 | else 226 | sendaddress[doomcom.numnodes].sin_port := htons(DOOMPORT); 227 | inc(doomcom.numnodes); 228 | end; 229 | 230 | printf('Total number of players : %d'#13#10, [doomcom.numnodes]); 231 | doomcom.id := DOOMCOM_ID; 232 | doomcom.numplayers := doomcom.numnodes; 233 | 234 | // build message to receive 235 | insocket := UDPsocket; 236 | BindToLocalPort(insocket,htons(DOOMPORT)); 237 | ioctlsocket(insocket, FIONBIO, trueval); 238 | 239 | sendsocket := UDPsocket; 240 | end; 241 | 242 | procedure I_NetCmd; 243 | begin 244 | if doomcom.command = CMD_SEND then 245 | netsend 246 | else if doomcom.command = CMD_GET then 247 | netget 248 | else 249 | I_Error('I_NetCmd(): Bad net cmd: %d', [doomcom.command]); 250 | end; 251 | 252 | end. 253 | 254 | -------------------------------------------------------------------------------- /z_memory.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit z_memory; 28 | 29 | interface 30 | 31 | // 32 | // PU - purge tags. 33 | // Tags < 100 are not overwritten until freed. 34 | 35 | const 36 | PU_LOTAG = 1; 37 | PU_STATIC = 1; // static entire execution time 38 | PU_SOUND = 2; // static while playing 39 | PU_MUSIC = 3; // static while playing 40 | PU_DAVE = 4; // anything else Dave wants static 41 | PU_LEVEL = 50; // static until level exited 42 | PU_LEVSPEC = 51; // a special thinker in a level 43 | // Tags >= 100 are purgable whenever needed. 44 | PU_PURGELEVEL = 100; 45 | PU_CACHE = 101; 46 | 47 | procedure Z_Init; 48 | procedure Z_ShutDown; 49 | 50 | function Z_Malloc(size: integer; tag: integer; user: pointer): pointer; 51 | function Z_Realloc(ptr: pointer; size: integer; tag: integer; user: pointer): pointer; 52 | 53 | procedure Z_Free(ptr: pointer); 54 | 55 | procedure Z_FreeTags(lowtag: integer; hightag: integer); 56 | 57 | procedure Z_ChangeTag(ptr: pointer; tag: integer); 58 | 59 | implementation 60 | 61 | uses 62 | d_delphi; 63 | 64 | type 65 | memmanageritem_t = record 66 | size: integer; 67 | user: PPointer; 68 | tag: integer; 69 | index: integer; 70 | end; 71 | Pmemmanageritem_t = ^memmanageritem_t; 72 | 73 | memmanageritems_t = array[0..$FFF] of Pmemmanageritem_t; 74 | Pmemmanageritems_t = ^memmanageritems_t; 75 | 76 | type 77 | TMemManager = class 78 | private 79 | fitems: Pmemmanageritems_t; 80 | fnumitems: integer; 81 | realsize: integer; 82 | function item2ptr(const id: integer): Pointer; 83 | function ptr2item(const ptr: Pointer): integer; 84 | public 85 | constructor Create; virtual; 86 | destructor Destroy; override; 87 | procedure M_Free(ptr: Pointer); 88 | procedure M_FreeTags(lowtag, hightag: integer); 89 | procedure M_ChangeTag(ptr: Pointer; tag: integer); 90 | function M_Malloc(size: integer; tag: integer; user: Pointer): pointer; 91 | function M_Realloc(ptr: Pointer; size: integer; tag: integer; user: Pointer): pointer; 92 | property items: Pmemmanageritems_t read fitems write fitems; 93 | property numitems: integer read fnumitems write fnumitems; 94 | end; 95 | 96 | constructor TMemManager.Create; 97 | begin 98 | fitems := nil; 99 | fnumitems := 0; 100 | realsize := 0; 101 | end; 102 | 103 | destructor TMemManager.Destroy; 104 | var 105 | i: integer; 106 | begin 107 | for i := fnumitems - 1 downto 0 do 108 | FreeMem(fitems[i], fitems[i].size + SizeOf(memmanageritem_t)); 109 | FreeMem(fitems, realsize * SizeOf(Pmemmanageritem_t)); 110 | inherited; 111 | end; 112 | 113 | function TMemManager.item2ptr(const id: integer): Pointer; 114 | begin 115 | Result := fitems[id]; 116 | incp(Result, SizeOf(memmanageritem_t)); 117 | end; 118 | 119 | function TMemManager.ptr2item(const ptr: Pointer): integer; 120 | var 121 | p: pointer; 122 | begin 123 | p := ptr; 124 | Result := Pmemmanageritem_t(incp(p, -SizeOf(memmanageritem_t))).index; 125 | end; 126 | 127 | procedure TMemManager.M_Free(ptr: Pointer); 128 | var 129 | i: integer; 130 | begin 131 | i := ptr2item(ptr); 132 | if fitems[i].user <> nil then 133 | fitems[i].user^ := nil; 134 | if fitems[i] <> nil then 135 | begin 136 | FreeMem(fitems[i], fitems[i].size + SizeOf(memmanageritem_t)); 137 | fitems[i] := nil; 138 | end; 139 | if i < fnumitems - 1 then 140 | begin 141 | fitems[i] := fitems[fnumitems - 1]; 142 | fitems[fnumitems - 1] := nil; 143 | fitems[i].index := i; 144 | end 145 | else 146 | fitems[i] := nil; 147 | dec(fnumitems); 148 | end; 149 | 150 | procedure TMemManager.M_FreeTags(lowtag, hightag: integer); 151 | var 152 | i: integer; 153 | begin 154 | for i := fnumitems - 1 downto 0 do 155 | if (fitems[i].tag >= lowtag) and (fitems[i].tag <= hightag) then 156 | M_Free(item2ptr(i)); 157 | end; 158 | 159 | procedure TMemManager.M_ChangeTag(ptr: Pointer; tag: integer); 160 | begin 161 | fitems[ptr2item(ptr)].tag := tag; 162 | end; 163 | 164 | function TMemManager.M_Malloc(size: integer; tag: integer; user: Pointer): pointer; 165 | var 166 | i: integer; 167 | begin 168 | if realsize <= fnumitems then 169 | begin 170 | realsize := (realsize * 4 div 3 + 64) and not 7; 171 | ReAllocMem(fitems, realsize * SizeOf(Pmemmanageritem_t)); 172 | for i := fnumitems + 1 to realsize - 1 do 173 | fitems[i] := nil; 174 | end; 175 | 176 | fitems[fnumitems] := malloc(size + SizeOf(memmanageritem_t)); 177 | fitems[fnumitems].size := size; 178 | fitems[fnumitems].tag := tag; 179 | fitems[fnumitems].index := fnumitems; 180 | fitems[fnumitems].user := user; 181 | Result := item2ptr(fnumitems); 182 | inc(fnumitems); 183 | if user <> nil then 184 | PPointer(user)^ := Result; 185 | end; 186 | 187 | function TMemManager.M_Realloc(ptr: Pointer; size: integer; tag: integer; user: Pointer): pointer; 188 | var 189 | tmp: pointer; 190 | copysize: integer; 191 | i: integer; 192 | begin 193 | if size = 0 then 194 | begin 195 | M_Free(ptr); 196 | Result := nil; 197 | Exit; 198 | end; 199 | 200 | if ptr = nil then 201 | begin 202 | Result := M_Malloc(size, tag, user); 203 | Exit; 204 | end; 205 | 206 | i := ptr2item(ptr); 207 | if fitems[i].size = size then 208 | begin 209 | Result := ptr; 210 | Exit; 211 | end; 212 | 213 | if size > fitems[i].size then 214 | copysize := fitems[i].size 215 | else 216 | copysize := size; 217 | 218 | tmp := malloc(copysize); 219 | memcpy(tmp, ptr, copysize); 220 | M_Free(ptr); 221 | Result := M_Malloc(size, tag, user); 222 | memcpy(Result, tmp, copysize); 223 | FreeMem(tmp, copysize); 224 | end; 225 | 226 | var 227 | memmanager: TMemManager; 228 | 229 | // Z_Init 230 | procedure Z_Init; 231 | begin 232 | memmanager := TMemManager.Create; 233 | end; 234 | 235 | procedure Z_ShutDown; 236 | begin 237 | memmanager.Free; 238 | end; 239 | 240 | // Z_Free 241 | procedure Z_Free(ptr: pointer); 242 | begin 243 | memmanager.M_Free(ptr); 244 | end; 245 | 246 | // Z_Malloc 247 | // You can pass a NULL user if the tag is < PU_PURGELEVEL. 248 | function Z_Malloc(size: integer; tag: integer; user: pointer): pointer; 249 | begin 250 | Result := memmanager.M_Malloc(size, tag, user); 251 | end; 252 | 253 | function Z_Realloc(ptr: pointer; size: integer; tag: integer; user: pointer): pointer; 254 | begin 255 | Result := memmanager.M_Realloc(ptr, size, tag, user); 256 | end; 257 | 258 | // Z_FreeTags 259 | procedure Z_FreeTags(lowtag: integer; hightag: integer); 260 | begin 261 | memmanager.M_FreeTags(lowtag, hightag); 262 | end; 263 | 264 | // Z_ChangeTag 265 | procedure Z_ChangeTag(ptr: pointer; tag: integer); 266 | begin 267 | memmanager.M_ChangeTag(ptr, tag); 268 | end; 269 | 270 | end. 271 | -------------------------------------------------------------------------------- /i_system.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit i_system; 28 | 29 | interface 30 | 31 | uses 32 | d_delphi, 33 | d_ticcmd; 34 | 35 | procedure I_Init; 36 | 37 | { Called by D_DoomLoop, } 38 | { returns current time in tics. } 39 | function I_GetTime: integer; 40 | function I_GetTime64: int64; 41 | 42 | procedure I_ClearInterface(var Dest: IInterface); 43 | 44 | { Called by D_DoomLoop, } 45 | { called before processing any tics in a frame } 46 | { (just after displaying a frame). } 47 | { Time consuming syncronous operations } 48 | { are performed here (joystick reading). } 49 | { Can call D_PostEvent. } 50 | procedure I_StartFrame; 51 | 52 | { Asynchronous interrupt functions should maintain private queues } 53 | { that are read by the synchronous functions } 54 | { to be converted into events. } 55 | { Either returns a null ticcmd, } 56 | { or calls a loadable driver to build it. } 57 | { This ticcmd will then be modified by the gameloop } 58 | { for normal input. } 59 | function I_BaseTiccmd: Pticcmd_t; 60 | 61 | { Called by M_Responder when quit is selected. } 62 | { Clean Exit, displays sell blurb. } 63 | procedure I_Quit; 64 | 65 | procedure I_Destroy; 66 | 67 | procedure I_Error(const error: string; const Args: array of const); overload; 68 | 69 | procedure I_Error(const error: string); overload; 70 | 71 | procedure I_ProcessWindows; 72 | 73 | function I_GameFinished: boolean; 74 | 75 | procedure I_WaitVBL(const cnt: integer); 76 | 77 | function I_SetDPIAwareness: boolean; 78 | 79 | type 80 | osversion_t = record 81 | minor, major, build: integer; 82 | end; 83 | 84 | function GetWindowsVersion: osversion_t; 85 | 86 | implementation 87 | 88 | uses 89 | Windows, 90 | Messages, 91 | doomdef, 92 | m_misc, 93 | i_main, 94 | i_video, 95 | i_sound, 96 | i_music, 97 | i_input, 98 | i_io, 99 | d_net, 100 | g_game, 101 | z_memory; 102 | 103 | var 104 | finished: boolean = False; 105 | 106 | function I_GameFinished: boolean; 107 | begin 108 | Result := finished; 109 | end; 110 | 111 | procedure I_ProcessWindows; 112 | var 113 | msg: TMsg; 114 | begin 115 | while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do 116 | begin 117 | if msg.message <> WM_QUIT then 118 | begin 119 | TranslateMessage(msg); 120 | DispatchMessage(msg); 121 | end; 122 | end; 123 | end; 124 | 125 | // I_StartFrame 126 | procedure I_StartFrame; 127 | begin 128 | I_ProcessWindows; 129 | I_ProcessMusic; 130 | I_ProcessInput; 131 | end; 132 | 133 | var 134 | emptycmd: ticcmd_t; 135 | 136 | function I_BaseTiccmd: Pticcmd_t; 137 | begin 138 | Result := @emptycmd; 139 | ZeroMemory(Result, SizeOf(ticcmd_t)); 140 | end; 141 | 142 | // I_GetTime 143 | // returns time in 1/70th second tics 144 | var 145 | basetime: int64 = 0; 146 | Freq: int64; 147 | invFreq: double; 148 | invFreq64: double; 149 | 150 | function I_GetTime: integer; 151 | var 152 | _time: int64; 153 | begin 154 | if Freq = 1000 then 155 | _time := GetTickCount 156 | else 157 | begin 158 | if not QueryPerformanceCounter(_time) then 159 | _time := GetTickCount; 160 | end; 161 | if basetime = 0 then 162 | basetime := _time; 163 | Result := round((_time - basetime) * invFreq); 164 | end; 165 | 166 | function I_GetTime64: int64; 167 | var 168 | _time: int64; 169 | begin 170 | if Freq = 1000 then 171 | _time := GetTickCount 172 | else 173 | begin 174 | if not QueryPerformanceCounter(_time) then 175 | _time := GetTickCount; 176 | end; 177 | if basetime = 0 then 178 | basetime := _time; 179 | Result := round((_time - basetime) * invFreq64); 180 | end; 181 | 182 | procedure I_ClearInterface(var Dest: IInterface); 183 | var 184 | P: Pointer; 185 | begin 186 | if Dest <> nil then 187 | begin 188 | P := Pointer(Dest); 189 | Pointer(Dest) := nil; 190 | IInterface(P)._Release; 191 | end; 192 | end; 193 | 194 | // I_Init 195 | procedure I_Init; 196 | begin 197 | printf('I_InitSound: Initializing DirectSound.' + #13#10); 198 | I_InitSound; 199 | printf('I_InitMusic: Initializing music.' + #13#10); 200 | I_InitMusic; 201 | printf('I_InitInput: Initializing DirectInput.' + #13#10); 202 | I_InitInput; 203 | end; 204 | 205 | // I_Quit 206 | procedure I_Quit; 207 | begin 208 | PostMessage(hMainWnd, WM_DESTROY, 0, 0); 209 | end; 210 | 211 | procedure I_Destroy; 212 | begin 213 | finished := True; 214 | D_QuitNetGame; 215 | I_ShutdownSound; 216 | I_ShutdownMusic; 217 | I_ShutDownInput; 218 | M_SaveDefaults; 219 | I_ShutdownGraphics; 220 | I_ShutdownIO; 221 | Z_ShutDown; 222 | Halt(0); 223 | end; 224 | 225 | // Wait for vertical retrace or pause a bit. 226 | procedure I_WaitVBL(const cnt: integer); 227 | begin 228 | sleep(cnt); 229 | end; 230 | 231 | // I_Error 232 | procedure I_Error(const error: string; const Args: array of const); 233 | var 234 | soutproc: TOutProc; 235 | begin 236 | fprintf(stderr, 'I_Error: ' + error + #13#10, Args); 237 | 238 | // Shutdown. Here might be other errors. 239 | if demorecording then 240 | G_CheckDemoStatus; 241 | 242 | soutproc := outproc; 243 | outproc := I_IOErrorMessageBox; 244 | printf(error, Args); 245 | outproc := soutproc; 246 | 247 | I_Destroy; 248 | end; 249 | 250 | procedure I_Error(const error: string); 251 | begin 252 | I_Error(error, []); 253 | end; 254 | 255 | type 256 | dpiproc_t = function: BOOL; stdcall; 257 | dpiproc2_t = function(value: integer): HRESULT; stdcall; 258 | 259 | function I_SetDPIAwareness: boolean; 260 | var 261 | dpifunc: dpiproc_t; 262 | dpifunc2: dpiproc2_t; 263 | dllinst: THandle; 264 | begin 265 | Result := False; 266 | 267 | dllinst := LoadLibrary('Shcore.dll'); 268 | if dllinst <> 0 then 269 | begin 270 | dpifunc2 := GetProcAddress(dllinst, 'SetProcessDpiAwareness'); 271 | if assigned(dpifunc2) then 272 | begin 273 | Result := dpifunc2(2) = S_OK; 274 | if not Result then 275 | Result := dpifunc2(1) = S_OK; 276 | end; 277 | FreeLibrary(dllinst); 278 | Exit; 279 | end; 280 | 281 | dllinst := LoadLibrary('user32'); 282 | dpifunc := GetProcAddress(dllinst, 'SetProcessDPIAware'); 283 | if assigned(dpifunc) then 284 | Result := dpifunc; 285 | FreeLibrary(dllinst); 286 | end; 287 | 288 | function GetWindowsVersion: osversion_t; 289 | var 290 | OSVersionInfo: TOSVersionInfo; 291 | begin 292 | OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo); 293 | if GetVersionEx(OSVersionInfo) then 294 | with OSVersionInfo do 295 | begin 296 | Result.major := dwMajorVersion; 297 | Result.minor := dwMinorVersion; 298 | if dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then 299 | Result.build := dwBuildNumber and $FFFF 300 | else 301 | Result.build := dwBuildNumber; 302 | end; 303 | end; 304 | 305 | initialization 306 | if not QueryPerformanceFrequency(Freq) then 307 | Freq := 1000; 308 | invFreq := 1 / Freq * TICRATE; 309 | invFreq64 := 1 / Freq * TICRATE * 65536; 310 | 311 | end. 312 | -------------------------------------------------------------------------------- /LaunchXS/main.pas: -------------------------------------------------------------------------------- 1 | unit main; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls, ComCtrls; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | SoundGroupBox: TGroupBox; 12 | InputGroupBox: TGroupBox; 13 | Label1: TLabel; 14 | Label2: TLabel; 15 | Label3: TLabel; 16 | Label4: TLabel; 17 | KeyboardRadioGroup: TRadioGroup; 18 | DetailCheckBox: TCheckBox; 19 | SmoothDisplayCheckBox: TCheckBox; 20 | AutorunModeCheckBox: TCheckBox; 21 | ScreenblocksTrackBar: TTrackBar; 22 | SFXTrackBar: TTrackBar; 23 | MusicTrackBar: TTrackBar; 24 | ChannelsTrackBar: TTrackBar; 25 | Button1: TButton; 26 | Button2: TButton; 27 | Button3: TButton; 28 | procedure FormCreate(Sender: TObject); 29 | procedure FormDestroy(Sender: TObject); 30 | procedure ScreenblocksTrackBarChange(Sender: TObject); 31 | procedure DetailCheckBoxClick(Sender: TObject); 32 | procedure SmoothDisplayCheckBoxClick(Sender: TObject); 33 | procedure SFXTrackBarChange(Sender: TObject); 34 | procedure MusicTrackBarChange(Sender: TObject); 35 | procedure ChannelsTrackBarChange(Sender: TObject); 36 | procedure Button1Click(Sender: TObject); 37 | procedure Button2Click(Sender: TObject); 38 | procedure Button3Click(Sender: TObject); 39 | procedure AutorunModeCheckBoxClick(Sender: TObject); 40 | private 41 | { Private declarations } 42 | defaults: TStringList; 43 | in_startup: boolean; 44 | procedure SetDefault(const defname: string; const defvalue: integer); 45 | function GetDefault(const defname: string): integer; 46 | procedure ToControls; 47 | procedure FromControls; 48 | public 49 | { Public declarations } 50 | end; 51 | 52 | var 53 | Form1: TForm1; 54 | 55 | implementation 56 | 57 | {$R *.dfm} 58 | 59 | procedure TForm1.FormCreate(Sender: TObject); 60 | var 61 | i: integer; 62 | begin 63 | DoubleBuffered := True; 64 | for i := 0 to ComponentCount - 1 do 65 | if Components[i].InheritsFrom(TWinControl) then 66 | (Components[i] as TWinControl).DoubleBuffered := True; 67 | defaults := TStringList.Create; 68 | if FileExists('default.cfg') then 69 | defaults.LoadFromFile('default.cfg') 70 | else 71 | defaults.Text := 72 | 'mouse_sensitivity=5'#13#10 + 73 | 'sfx_volume=15'#13#10 + 74 | 'music_volume=15'#13#10 + 75 | 'show_messages=1'#13#10 + 76 | 'key_right=174'#13#10 + 77 | 'key_left=172'#13#10 + 78 | 'key_up=173'#13#10 + 79 | 'key_down=175'#13#10 + 80 | 'key_strafeleft=44'#13#10 + 81 | 'key_straferight=46'#13#10 + 82 | 'key_fire=157'#13#10 + 83 | 'key_use=32'#13#10 + 84 | 'key_strafe=184'#13#10 + 85 | 'key_speed=182'#13#10 + 86 | 'autorun_mode=0'#13#10 + 87 | 'use_mouse=1'#13#10 + 88 | 'mouseb_fire=0'#13#10 + 89 | 'mouseb_strafe=1'#13#10 + 90 | 'mouseb_forward=2'#13#10 + 91 | 'use_joystick=0'#13#10 + 92 | 'joyb_fire=0'#13#10 + 93 | 'joyb_strafe=1'#13#10 + 94 | 'joyb_use=3'#13#10 + 95 | 'joyb_speed=2'#13#10 + 96 | 'screenblocks=10'#13#10 + 97 | 'detaillevel=0'#13#10 + 98 | 'smoothdisplay=1'#13#10 + 99 | 'snd_channels=8'#13#10 + 100 | 'usegamma=0'#13#10 + 101 | 'chatmacro0=No'#13#10 + 102 | 'chatmacro1=I''m ready to kick butt!'#13#10 + 103 | 'chatmacro2=I''m OK.'#13#10 + 104 | 'chatmacro3=I''m not looking too good!'#13#10 + 105 | 'chatmacro4=Help!'#13#10 + 106 | 'chatmacro5=You suck!'#13#10 + 107 | 'chatmacro6=Next time, scumbag...'#13#10 + 108 | 'chatmacro7=Come here!'#13#10 + 109 | 'chatmacro8=I''ll take care of it.'#13#10 + 110 | 'chatmacro9=Yes'; 111 | 112 | in_startup := True; 113 | ToControls; 114 | in_startup := False; 115 | end; 116 | 117 | procedure TForm1.FormDestroy(Sender: TObject); 118 | begin 119 | defaults.Free; 120 | end; 121 | 122 | procedure TForm1.SetDefault(const defname: string; const defvalue: integer); 123 | begin 124 | if defaults.IndexOfName(defname) < 0 then 125 | defaults.Add(defname + '=' + IntToStr(defvalue)) 126 | else 127 | defaults.Values[defname] := IntToStr(defvalue); 128 | end; 129 | 130 | function TForm1.GetDefault(const defname: string): integer; 131 | begin 132 | Result := StrToIntDef(defaults.Values[defname], 0); 133 | end; 134 | 135 | procedure TForm1.ToControls; 136 | begin 137 | if (GetDefault('key_up') = 173) and 138 | (GetDefault('key_down') = 175) and 139 | (GetDefault('key_strafeleft') = 44) and 140 | (GetDefault('key_straferight') = 46) then 141 | KeyboardRadioGroup.ItemIndex := 0 142 | else if (GetDefault('key_up') = 119) and 143 | (GetDefault('key_down') = 115) and 144 | (GetDefault('key_strafeleft') = 97) and 145 | (GetDefault('key_straferight') = 100) then 146 | KeyboardRadioGroup.ItemIndex := 1 147 | else 148 | KeyboardRadioGroup.ItemIndex := 2; 149 | DetailCheckBox.Checked := GetDefault('detaillevel') = 1; 150 | SmoothDisplayCheckBox.Checked := GetDefault('smoothdisplay') = 1; 151 | ScreenblocksTrackBar.Position := GetDefault('screenblocks'); 152 | SFXTrackBar.Position := GetDefault('sfx_volume'); 153 | MusicTrackBar.Position := GetDefault('music_volume'); 154 | ChannelsTrackBar.Position := GetDefault('snd_channels'); 155 | AutorunModeCheckBox.Checked := GetDefault('autorun_mode') = 1; 156 | end; 157 | 158 | procedure TForm1.FromControls; 159 | begin 160 | if in_startup then 161 | Exit; 162 | if KeyboardRadioGroup.ItemIndex = 0 then 163 | begin 164 | SetDefault('key_up', 173); 165 | SetDefault('key_down', 175); 166 | SetDefault('key_strafeleft', 44); 167 | SetDefault('key_straferight', 46); 168 | end 169 | else if KeyboardRadioGroup.ItemIndex = 1 then 170 | begin 171 | SetDefault('key_up', 119); 172 | SetDefault('key_down', 115); 173 | SetDefault('key_strafeleft', 97); 174 | SetDefault('key_straferight', 100); 175 | end; 176 | 177 | if DetailCheckBox.Checked then 178 | SetDefault('detaillevel', 1) 179 | else 180 | SetDefault('detaillevel', 0); 181 | 182 | if SmoothDisplayCheckBox.Checked then 183 | SetDefault('smoothdisplay', 1) 184 | else 185 | SetDefault('smoothdisplay', 0); 186 | 187 | SetDefault('screenblocks', ScreenblocksTrackBar.Position); 188 | SetDefault('sfx_volume', SFXTrackBar.Position); 189 | SetDefault('music_volume', MusicTrackBar.Position); 190 | SetDefault('snd_channels', ChannelsTrackBar.Position); 191 | 192 | if AutorunModeCheckBox.Checked then 193 | SetDefault('autorun_mode', 1) 194 | else 195 | SetDefault('autorun_mode', 0); 196 | end; 197 | 198 | procedure TForm1.ScreenblocksTrackBarChange(Sender: TObject); 199 | begin 200 | FromControls; 201 | end; 202 | 203 | procedure TForm1.DetailCheckBoxClick(Sender: TObject); 204 | begin 205 | FromControls; 206 | end; 207 | 208 | procedure TForm1.SmoothDisplayCheckBoxClick(Sender: TObject); 209 | begin 210 | FromControls; 211 | end; 212 | 213 | procedure TForm1.SFXTrackBarChange(Sender: TObject); 214 | begin 215 | FromControls; 216 | end; 217 | 218 | procedure TForm1.MusicTrackBarChange(Sender: TObject); 219 | begin 220 | FromControls; 221 | end; 222 | 223 | procedure TForm1.ChannelsTrackBarChange(Sender: TObject); 224 | begin 225 | FromControls; 226 | end; 227 | 228 | procedure TForm1.Button1Click(Sender: TObject); 229 | var 230 | weret: integer; 231 | errmsg: string; 232 | begin 233 | FromControls; 234 | defaults.SaveToFile('default.cfg'); 235 | weret := WinExec(PChar('DoomXS.exe'), SW_SHOWNORMAL); 236 | if weret > 31 then 237 | Close 238 | else 239 | begin 240 | if weret = 0 then 241 | errmsg := 'The system is out of memory or resources.' 242 | else if weret = ERROR_BAD_FORMAT then 243 | errmsg := 'The "DoomXS.exe" file is invalid (non-Win32 .EXE or error in .EXE image).' 244 | else if weret = ERROR_FILE_NOT_FOUND then 245 | errmsg := 'The "DoomXS.exe" file was not found.' 246 | else if weret = ERROR_PATH_NOT_FOUND then 247 | errmsg := 'Path not found.' 248 | else 249 | errmsg := 'Can not run "DoomXS.exe".'; 250 | 251 | ShowMessage(errmsg); 252 | end; 253 | end; 254 | 255 | procedure TForm1.Button2Click(Sender: TObject); 256 | begin 257 | FromControls; 258 | defaults.SaveToFile('default.cfg'); 259 | end; 260 | 261 | procedure TForm1.Button3Click(Sender: TObject); 262 | begin 263 | Close; 264 | end; 265 | 266 | procedure TForm1.AutorunModeCheckBoxClick(Sender: TObject); 267 | begin 268 | FromControls; 269 | end; 270 | 271 | end. 272 | -------------------------------------------------------------------------------- /p_ceilng.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_ceilng; 28 | 29 | interface 30 | 31 | uses 32 | z_memory, 33 | p_spec, 34 | r_defs, 35 | s_sound, 36 | sounds; 37 | 38 | var 39 | activeceilings: array[0..MAXCEILINGS - 1] of Pceiling_t; 40 | 41 | procedure T_MoveCeiling(ceiling: Pceiling_t); 42 | 43 | function EV_DoCeiling(line: Pline_t; typ: ceiling_e): integer; 44 | 45 | procedure P_AddActiveCeiling(c: Pceiling_t); 46 | 47 | function EV_CeilingCrushStop(line: Pline_t): integer; 48 | 49 | implementation 50 | 51 | uses 52 | m_fixed, 53 | p_tick, 54 | p_setup, 55 | p_floor; 56 | 57 | // Add an active ceiling 58 | procedure P_AddActiveCeiling(c: Pceiling_t); 59 | var 60 | i: integer; 61 | begin 62 | for i := 0 to MAXCEILINGS - 1 do 63 | if activeceilings[i] = nil then 64 | begin 65 | activeceilings[i] := c; 66 | Exit; 67 | end; 68 | end; 69 | 70 | // Remove a ceiling's thinker 71 | procedure P_RemoveActiveCeiling(c: Pceiling_t); 72 | var 73 | i: integer; 74 | begin 75 | for i := 0 to MAXCEILINGS - 1 do 76 | if activeceilings[i] = c then 77 | begin 78 | activeceilings[i].sector.specialdata := nil; 79 | P_RemoveThinker(@activeceilings[i].thinker); 80 | activeceilings[i] := nil; 81 | Exit; 82 | end; 83 | end; 84 | 85 | // Restart a ceiling that's in-stasis 86 | procedure P_ActivateInStasisCeiling(line: Pline_t); 87 | var 88 | i: integer; 89 | begin 90 | for i := 0 to MAXCEILINGS - 1 do 91 | if (activeceilings[i] <> nil) and (activeceilings[i].tag = line.tag) and 92 | (activeceilings[i].direction = 0) then 93 | begin 94 | activeceilings[i].direction := activeceilings[i].olddirection; 95 | activeceilings[i].thinker.func.acp1 := @T_MoveCeiling; 96 | end; 97 | end; 98 | 99 | // T_MoveCeiling 100 | procedure T_MoveCeiling(ceiling: Pceiling_t); 101 | var 102 | res: result_e; 103 | begin 104 | case ceiling.direction of 105 | 0: 106 | // IN STASIS 107 | begin 108 | end; 109 | 1: 110 | // UP 111 | begin 112 | res := T_MovePlane(ceiling.sector, ceiling.speed, 113 | ceiling.topheight, False, 1, ceiling.direction); 114 | 115 | if leveltime and 7 = 0 then 116 | begin 117 | if ceiling.typ <> silentCrushAndRaise then 118 | S_StartSound(@ceiling.sector.soundorg, Ord(sfx_stnmov)); 119 | end; 120 | 121 | if res = pastdest then 122 | begin 123 | case ceiling.typ of 124 | raiseToHighest: 125 | P_RemoveActiveCeiling(ceiling); 126 | silentCrushAndRaise: 127 | begin 128 | S_StartSound(@ceiling.sector.soundorg, Ord(sfx_pstop)); 129 | ceiling.direction := -1; 130 | end; 131 | fastCrushAndRaise, 132 | crushAndRaise: 133 | ceiling.direction := -1; 134 | end; 135 | end; 136 | end; 137 | -1: 138 | // DOWN 139 | begin 140 | res := T_MovePlane(ceiling.sector, ceiling.speed, 141 | ceiling.bottomheight, ceiling.crush, 1, ceiling.direction); 142 | 143 | if leveltime and 7 = 0 then 144 | begin 145 | if ceiling.typ <> silentCrushAndRaise then 146 | S_StartSound(@ceiling.sector.soundorg, Ord(sfx_stnmov)); 147 | end; 148 | 149 | if res = pastdest then 150 | begin 151 | case ceiling.typ of 152 | silentCrushAndRaise: 153 | begin 154 | S_StartSound(@ceiling.sector.soundorg, Ord(sfx_pstop)); 155 | ceiling.speed := CEILSPEED; 156 | ceiling.direction := 1; 157 | end; 158 | crushAndRaise: 159 | begin 160 | ceiling.speed := CEILSPEED; 161 | ceiling.direction := 1; 162 | end; 163 | fastCrushAndRaise: 164 | begin 165 | ceiling.direction := 1; 166 | end; 167 | lowerAndCrush, 168 | lowerToFloor: 169 | P_RemoveActiveCeiling(ceiling); 170 | end; 171 | end 172 | else // ( res <> pastdest ) 173 | begin 174 | if res = crushed then 175 | begin 176 | case ceiling.typ of 177 | silentCrushAndRaise, 178 | crushAndRaise, 179 | lowerAndCrush: 180 | ceiling.speed := CEILSPEED div 8; 181 | end; 182 | end; 183 | end; 184 | end; 185 | end; 186 | end; 187 | 188 | // EV_DoCeiling 189 | // Move a ceiling up/down and all around! 190 | function EV_DoCeiling(line: Pline_t; typ: ceiling_e): integer; 191 | var 192 | initial: boolean; 193 | secnum: integer; 194 | sec: Psector_t; 195 | ceiling: Pceiling_t; 196 | begin 197 | secnum := -1; 198 | Result := 0; 199 | 200 | // Reactivate in-stasis ceilings...for certain types. 201 | case typ of 202 | fastCrushAndRaise, 203 | silentCrushAndRaise, 204 | crushAndRaise: 205 | P_ActivateInStasisCeiling(line); 206 | end; 207 | 208 | initial := True; 209 | while (secnum >= 0) or initial do 210 | begin 211 | initial := False; 212 | secnum := P_FindSectorFromLineTag(line, secnum); 213 | if secnum < 0 then 214 | Break; 215 | 216 | sec := @sectors[secnum]; 217 | if sec.specialdata <> nil then 218 | Continue; 219 | 220 | // new door thinker 221 | Result := 1; 222 | ceiling := Z_Malloc(SizeOf(ceiling_t), PU_LEVSPEC, nil); 223 | P_AddThinker(@ceiling.thinker); 224 | sec.specialdata := ceiling; 225 | ceiling.thinker.func.acp1 := @T_MoveCeiling; 226 | ceiling.sector := sec; 227 | ceiling.crush := False; 228 | 229 | case typ of 230 | fastCrushAndRaise: 231 | begin 232 | ceiling.crush := True; 233 | ceiling.topheight := sec.ceilingheight; 234 | ceiling.bottomheight := sec.floorheight + (8 * FRACUNIT); 235 | ceiling.direction := -1; 236 | ceiling.speed := CEILSPEED * 2; 237 | end; 238 | 239 | silentCrushAndRaise, 240 | crushAndRaise: 241 | begin 242 | ceiling.crush := True; 243 | ceiling.topheight := sec.ceilingheight; 244 | ceiling.bottomheight := sec.floorheight; 245 | if typ <> lowerToFloor then 246 | ceiling.bottomheight := ceiling.bottomheight + 8 * FRACUNIT; 247 | ceiling.direction := -1; 248 | ceiling.speed := CEILSPEED; 249 | end; 250 | lowerAndCrush, 251 | lowerToFloor: 252 | begin 253 | ceiling.bottomheight := sec.floorheight; 254 | if typ <> lowerToFloor then 255 | ceiling.bottomheight := ceiling.bottomheight + 8 * FRACUNIT; 256 | ceiling.direction := -1; 257 | ceiling.speed := CEILSPEED; 258 | end; 259 | 260 | raiseToHighest: 261 | begin 262 | ceiling.topheight := P_FindHighestCeilingSurrounding(sec); 263 | ceiling.direction := 1; 264 | ceiling.speed := CEILSPEED; 265 | end; 266 | end; 267 | 268 | ceiling.tag := sec.tag; 269 | ceiling.typ := typ; 270 | P_AddActiveCeiling(ceiling); 271 | end; 272 | end; 273 | 274 | // EV_CeilingCrushStop 275 | // Stop a ceiling from crushing! 276 | function EV_CeilingCrushStop(line: Pline_t): integer; 277 | var 278 | i: integer; 279 | begin 280 | Result := 0; 281 | for i := 0 to MAXCEILINGS - 1 do 282 | if (activeceilings[i] <> nil) and (activeceilings[i].tag = line.tag) and 283 | (activeceilings[i].direction <> 0) then 284 | begin 285 | activeceilings[i].olddirection := activeceilings[i].direction; 286 | activeceilings[i].thinker.func.acv := nil; 287 | activeceilings[i].direction := 0; // in-stasis 288 | Result := 1; 289 | end; 290 | end; 291 | 292 | end. 293 | 294 | 295 | -------------------------------------------------------------------------------- /i_input.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit i_input; 28 | 29 | interface 30 | 31 | procedure I_InitInput; 32 | 33 | procedure I_ProcessInput; 34 | 35 | procedure I_ShutDownInput; 36 | 37 | procedure I_SynchronizeInput(active: boolean); 38 | 39 | function I_GetCapsLock: boolean; 40 | 41 | procedure I_SetCapsLock(const bState: boolean); 42 | 43 | implementation 44 | 45 | uses 46 | Windows, 47 | d_delphi, 48 | MMSystem, // For joystick support 49 | doomdef, 50 | d_event, 51 | d_main, 52 | i_main, 53 | i_system; 54 | 55 | function TranslateKey(keycode: integer): integer; 56 | begin 57 | case keycode of 58 | VK_LEFT, VK_NUMPAD4: Result := KEY_LEFTARROW; 59 | VK_RIGHT, VK_NUMPAD6: Result := KEY_RIGHTARROW; 60 | VK_DOWN, VK_NUMPAD2: Result := KEY_DOWNARROW; 61 | VK_UP, VK_NUMPAD8: Result := KEY_UPARROW; 62 | VK_ESCAPE: Result := KEY_ESCAPE; 63 | VK_RETURN: Result := KEY_ENTER; 64 | VK_TAB: Result := KEY_TAB; 65 | VK_SNAPSHOT: result := KEY_PRNT; 66 | VK_F1: Result := KEY_F1; 67 | VK_F2: Result := KEY_F2; 68 | VK_F3: Result := KEY_F3; 69 | VK_F4: Result := KEY_F4; 70 | VK_F5: Result := KEY_F5; 71 | VK_F6: Result := KEY_F6; 72 | VK_F7: Result := KEY_F7; 73 | VK_F8: Result := KEY_F8; 74 | VK_F9: Result := KEY_F9; 75 | VK_F10: Result := KEY_F10; 76 | VK_F11: Result := KEY_F11; 77 | VK_F12: Result := KEY_F12; 78 | 189: Result := KEY_MINUS; 79 | 187: Result := KEY_EQUALS; 80 | VK_BACK: Result := KEY_BACKSPACE; 81 | VK_PAUSE: Result := KEY_PAUSE; 82 | VK_NUMPAD3: Result := KEY_PAGEDOWN; 83 | VK_NUMPAD9: Result := KEY_PAGEUP; 84 | VK_NUMPAD0: Result := KEY_INS; 85 | else 86 | if (keycode >= Ord('A')) and (keycode <= Ord('Z')) then 87 | Result := Ord(tolower(Chr(keycode))) 88 | else if keycode < 128 then 89 | Result := keycode 90 | else 91 | Result := 0; 92 | end; 93 | end; 94 | 95 | function TranslateSysKey(keycode: integer): integer; 96 | begin 97 | case keycode of 98 | VK_SHIFT: Result := KEY_RSHIFT; 99 | VK_CONTROL: Result := KEY_RCTRL; 100 | VK_MENU: Result := KEY_RALT; 101 | else 102 | Result := 0; 103 | end; 104 | end; 105 | 106 | var 107 | curkeys: PKeyboardState; 108 | oldkeys: PKeyboardState; 109 | // Mouse support 110 | mlastx, 111 | mlasty: integer; 112 | mflags: byte; 113 | // Joystick support 114 | jInfo: TJoyInfoEx; 115 | jPresent: boolean; 116 | jwXpos: UINT; 117 | jwYpos: UINT; 118 | 119 | type 120 | setcursorposfunc_t = function(x, y:Integer): BOOL; stdcall; 121 | getcursorposfunc_t = function(var lpPoint: TPoint): BOOL; stdcall; 122 | 123 | var 124 | getcursorposfunc: getcursorposfunc_t; 125 | setcursorposfunc: setcursorposfunc_t; 126 | user32inst: THandle; 127 | 128 | procedure I_InitMouse; 129 | begin 130 | user32inst := LoadLibrary(user32); 131 | getcursorposfunc := GetProcAddress(user32inst, 'GetPhysicalCursorPos'); 132 | if not assigned(getcursorposfunc) then 133 | getcursorposfunc := GetProcAddress(user32inst, 'GetCursorPos'); 134 | setcursorposfunc := GetProcAddress(user32inst, 'SetPhysicalCursorPos'); 135 | if not assigned(setcursorposfunc) then 136 | setcursorposfunc := GetProcAddress(user32inst, 'SetCursorPos'); 137 | end; 138 | 139 | procedure I_ShutDownMouse; 140 | begin 141 | FreeLibrary(user32inst); 142 | end; 143 | 144 | procedure I_ResetMouse; 145 | begin 146 | mlastx := SCREENWIDTH div 2; 147 | mlasty := SCREENHEIGHT div 2; 148 | setcursorposfunc(mlastx, mlasty); 149 | mflags := 0; 150 | end; 151 | 152 | procedure I_InitInput; 153 | begin 154 | curkeys := malloc(SizeOf(TKeyboardState)); 155 | oldkeys := malloc(SizeOf(TKeyboardState)); 156 | 157 | I_InitMouse; 158 | I_ResetMouse; 159 | printf(' Mouse initialized'#13#10); 160 | 161 | jPresent := joyGetNumDevs > 0; 162 | if jPresent then 163 | jPresent := joySetCapture(hMainWnd, JOYSTICKID1, 0, False) = JOYERR_NOERROR; 164 | 165 | // Get initial joystic position 166 | if jPresent then 167 | begin 168 | ZeroMemory(@jInfo, SizeOf(TJoyInfoEx)); 169 | jInfo.dwSize := SizeOf(TJoyInfoEx); 170 | jInfo.dwFlags := JOY_RETURNALL; 171 | if joyGetPosEx(JOYSTICKID1, @jInfo) = JOYERR_NOERROR then 172 | begin 173 | jwXpos := jInfo.wXpos; 174 | jwYpos := jInfo.wYpos; 175 | end; 176 | printf(' Joystick initialized'#13#10); 177 | end 178 | else 179 | printf(' Joystick not found'#13#10); 180 | 181 | end; 182 | 183 | procedure I_ShutDownInput; 184 | begin 185 | FreeMem(curkeys); 186 | FreeMem(oldkeys); 187 | 188 | joyReleaseCapture(JOYSTICKID1); 189 | 190 | I_ShutDownMouse; 191 | end; 192 | 193 | var 194 | input_active: boolean; 195 | 196 | procedure I_ProcessInput; 197 | var 198 | i: integer; 199 | ev: event_t; 200 | key: integer; 201 | p: PKeyboardState; 202 | pt: TPoint; 203 | begin 204 | if I_GameFinished or not input_active then 205 | Exit; 206 | 207 | GetKeyboardState(curkeys^); 208 | 209 | ZeroMemory(@ev, SizeOf(ev)); 210 | 211 | for i := 0 to SizeOf(curkeys^) - 1 do 212 | begin 213 | if (oldkeys[i] and $80) <> (curkeys[i] and $80) then 214 | begin 215 | key := TranslateKey(i); 216 | if key <> 0 then 217 | begin 218 | if curkeys[i] and $80 <> 0 then 219 | ev.typ := ev_keydown 220 | else 221 | ev.typ := ev_keyup; 222 | ev.data1 := key; 223 | D_PostEvent(@ev); 224 | end; 225 | 226 | key := TranslateSysKey(i); 227 | if key <> 0 then 228 | begin 229 | if curkeys[i] and $80 <> 0 then 230 | ev.typ := ev_keydown 231 | else 232 | ev.typ := ev_keyup; 233 | ev.data1 := key; 234 | D_PostEvent(@ev); 235 | end; 236 | end; 237 | end; 238 | 239 | p := oldkeys; 240 | oldkeys := curkeys; 241 | curkeys := p; 242 | 243 | // Mouse 244 | if GetKeyState(VK_LBUTTON) < 0 then 245 | mflags := mflags or 1; 246 | if GetKeyState(VK_RBUTTON) < 0 then 247 | mflags := mflags or 2; 248 | if GetKeyState(VK_MBUTTON) < 0 then 249 | mflags := mflags or 4; 250 | 251 | getcursorposfunc(pt); 252 | 253 | ev.typ := ev_mouse; 254 | ev.data1 := mflags; 255 | ev.data2 := mlastx - pt.x; 256 | ev.data3 := mlasty - pt.y; 257 | D_PostEvent(@ev); 258 | 259 | I_ResetMouse; 260 | 261 | // Joystick 262 | if jPresent then 263 | begin 264 | ZeroMemory(@jInfo, SizeOf(TJoyInfoEx)); 265 | jInfo.dwSize := SizeOf(TJoyInfoEx); 266 | jInfo.dwFlags := JOY_RETURNALL; 267 | if joyGetPosEx(JOYSTICKID1, @jInfo) = JOYERR_NOERROR then 268 | begin 269 | ev.typ := ev_joystick; 270 | if jInfo.dwButtonNumber > 0 then 271 | ev.data1 := jInfo.wButtons and ((1 shl NUMJOYBUTTONS) - 1) // Only first NUMJOYBUTTONS buttons of joystic in use 272 | else 273 | ev.data1 := 0; 274 | ev.data2 := jInfo.wXpos - jwXpos; 275 | ev.data3 := jInfo.wYpos - jwYpos; 276 | D_PostEvent(@ev); 277 | end; 278 | end; 279 | end; 280 | 281 | procedure I_SynchronizeInput(active: boolean); 282 | begin 283 | input_active := active; 284 | end; 285 | 286 | function I_GetCapsLock: boolean; 287 | begin 288 | result := GetKeyState(VK_CAPITAL) and 1 <> 0; 289 | end; 290 | 291 | procedure I_SetCapsLock(const bState: boolean); 292 | var 293 | keyState: TKeyboardState; 294 | begin 295 | GetKeyboardState(keyState); 296 | if bState <> (keyState[VK_CAPITAL] and 1 <> 0) then 297 | begin 298 | // Simulate a key press 299 | keybd_event(VK_CAPITAL, $3A, KEYEVENTF_EXTENDEDKEY, 0); 300 | 301 | // Simulate a key release 302 | keybd_event(VK_CAPITAL, $3A, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); 303 | end; 304 | end; 305 | 306 | end. 307 | -------------------------------------------------------------------------------- /p_plats.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_plats; 28 | 29 | interface 30 | 31 | uses 32 | p_spec, 33 | r_defs; 34 | 35 | var 36 | activeplats: array[0..MAXPLATS - 1] of Pplat_t; 37 | 38 | procedure T_PlatRaise(plat: Pplat_t); 39 | 40 | function EV_DoPlat(line: Pline_t; typ: plattype_e; amount: integer): integer; 41 | 42 | procedure P_ActivateInStasis(tag: integer); 43 | 44 | procedure EV_StopPlat(line: Pline_t); 45 | 46 | procedure P_AddActivePlat(plat: Pplat_t); 47 | 48 | procedure P_RemoveActivePlat(plat: Pplat_t); 49 | 50 | implementation 51 | 52 | uses 53 | doomdef, 54 | m_fixed, 55 | i_system, 56 | m_rnd, 57 | p_tick, 58 | p_floor, 59 | p_setup, 60 | s_sound, 61 | sounds, 62 | z_memory; 63 | 64 | procedure T_PlatRaise(plat: Pplat_t); 65 | var 66 | res: result_e; 67 | begin 68 | case plat.status of 69 | up: 70 | begin 71 | res := T_MovePlane(plat.sector, plat.speed, plat.high, plat.crush, 0, 1); 72 | 73 | if (plat.typ = raiseAndChange) or (plat.typ = raiseToNearestAndChange) then 74 | begin 75 | if leveltime and 7 = 0 then 76 | S_StartSound(@plat.sector.soundorg, Ord(sfx_stnmov)); 77 | end; 78 | 79 | if (res = crushed) and not plat.crush then 80 | begin 81 | plat.count := plat.wait; 82 | plat.status := down; 83 | S_StartSound(@plat.sector.soundorg, Ord(sfx_pstart)); 84 | end 85 | else 86 | begin 87 | if res = pastdest then 88 | begin 89 | plat.count := plat.wait; 90 | plat.status := waiting; 91 | S_StartSound(@plat.sector.soundorg, Ord(sfx_pstop)); 92 | 93 | case plat.typ of 94 | blazeDWUS, 95 | downWaitUpStay: 96 | P_RemoveActivePlat(plat); 97 | raiseAndChange, 98 | raiseToNearestAndChange: 99 | P_RemoveActivePlat(plat); 100 | end; 101 | end; 102 | end; 103 | end; 104 | down: 105 | begin 106 | res := T_MovePlane(plat.sector, plat.speed, plat.low, False, 0, -1); 107 | 108 | if res = pastdest then 109 | begin 110 | plat.count := plat.wait; 111 | plat.status := waiting; 112 | S_StartSound(@plat.sector.soundorg, Ord(sfx_pstop)); 113 | end; 114 | end; 115 | waiting: 116 | begin 117 | plat.count := plat.count - 1; 118 | if plat.count = 0 then 119 | begin 120 | if plat.sector.floorheight = plat.low then 121 | plat.status := up 122 | else 123 | plat.status := down; 124 | S_StartSound(@plat.sector.soundorg, Ord(sfx_pstart)); 125 | end; 126 | end; 127 | end; 128 | end; 129 | 130 | // Do Platforms 131 | // "amount" is only used for SOME platforms. 132 | function EV_DoPlat(line: Pline_t; typ: plattype_e; amount: integer): integer; 133 | var 134 | plat: Pplat_t; 135 | secnum: integer; 136 | sec: Psector_t; 137 | begin 138 | Result := 0; 139 | 140 | // Activate all plats that are in_stasis 141 | if typ = perpetualRaise then 142 | P_ActivateInStasis(line.tag); 143 | 144 | secnum := P_FindSectorFromLineTag(line, -1); 145 | while secnum >= 0 do 146 | begin 147 | sec := @sectors[secnum]; 148 | secnum := P_FindSectorFromLineTag(line, secnum); 149 | 150 | if sec.specialdata <> nil then 151 | Continue; 152 | 153 | // Find lowest & highest floors around sector 154 | Result := 1; 155 | plat := Z_Malloc(SizeOf(plat_t), PU_LEVSPEC, nil); 156 | P_AddThinker(@plat.thinker); 157 | 158 | plat.typ := typ; 159 | plat.sector := sec; 160 | plat.sector.specialdata := plat; 161 | plat.thinker.func.acp1 := @T_PlatRaise; 162 | plat.crush := False; 163 | plat.tag := line.tag; 164 | 165 | case typ of 166 | raiseToNearestAndChange: 167 | begin 168 | plat.speed := PLATSPEED div 2; 169 | sec.floorpic := sides[line.sidenum[0]].sector.floorpic; 170 | plat.high := P_FindNextHighestFloor(sec, sec.floorheight); 171 | plat.wait := 0; 172 | plat.status := up; 173 | // NO MORE DAMAGE, IF APPLICABLE 174 | sec.special := 0; 175 | S_StartSound(@sec.soundorg, Ord(sfx_stnmov)); 176 | end; 177 | 178 | raiseAndChange: 179 | begin 180 | plat.speed := PLATSPEED div 2; 181 | sec.floorpic := sides[line.sidenum[0]].sector.floorpic; 182 | plat.high := sec.floorheight + amount * FRACUNIT; 183 | plat.wait := 0; 184 | plat.status := up; 185 | S_StartSound(@sec.soundorg, Ord(sfx_stnmov)); 186 | end; 187 | downWaitUpStay: 188 | begin 189 | plat.speed := PLATSPEED * 4; 190 | plat.low := P_FindLowestFloorSurrounding(sec); 191 | if plat.low > sec.floorheight then 192 | plat.low := sec.floorheight; 193 | plat.high := sec.floorheight; 194 | plat.wait := TICRATE * PLATWAIT; 195 | plat.status := down; 196 | S_StartSound(@sec.soundorg, Ord(sfx_pstart)); 197 | end; 198 | blazeDWUS: 199 | begin 200 | plat.speed := PLATSPEED * 8; 201 | plat.low := P_FindLowestFloorSurrounding(sec); 202 | if plat.low > sec.floorheight then 203 | plat.low := sec.floorheight; 204 | plat.high := sec.floorheight; 205 | plat.wait := TICRATE * PLATWAIT; 206 | plat.status := down; 207 | S_StartSound(@sec.soundorg, Ord(sfx_pstart)); 208 | end; 209 | perpetualRaise: 210 | begin 211 | plat.speed := PLATSPEED; 212 | plat.low := P_FindLowestFloorSurrounding(sec); 213 | if plat.low > sec.floorheight then 214 | plat.low := sec.floorheight; 215 | plat.high := P_FindHighestFloorSurrounding(sec); 216 | if plat.high < sec.floorheight then 217 | plat.high := sec.floorheight; 218 | plat.wait := TICRATE * PLATWAIT; 219 | plat.status := plat_e(P_Random and 1); 220 | S_StartSound(@sec.soundorg, Ord(sfx_pstart)); 221 | end; 222 | end; 223 | P_AddActivePlat(plat); 224 | end; 225 | end; 226 | 227 | procedure P_ActivateInStasis(tag: integer); 228 | var 229 | i: integer; 230 | begin 231 | for i := 0 to MAXPLATS - 1 do 232 | if (activeplats[i] <> nil) and (activeplats[i].tag = tag) and 233 | (activeplats[i].status = in_stasis) then 234 | begin 235 | activeplats[i].status := activeplats[i].oldstatus; 236 | activeplats[i].thinker.func.acp1 := @T_PlatRaise; 237 | end; 238 | end; 239 | 240 | 241 | procedure EV_StopPlat(line: Pline_t); 242 | var 243 | i: integer; 244 | begin 245 | for i := 0 to MAXPLATS - 1 do 246 | if (activeplats[i] <> nil) and (activeplats[i].status <> in_stasis) and 247 | (activeplats[i].tag = line.tag) then 248 | begin 249 | activeplats[i].oldstatus := activeplats[i].status; 250 | activeplats[i].status := in_stasis; 251 | activeplats[i].thinker.func.acv := nil; 252 | end; 253 | end; 254 | 255 | procedure P_AddActivePlat(plat: Pplat_t); 256 | var 257 | i: integer; 258 | begin 259 | for i := 0 to MAXPLATS - 1 do 260 | if activeplats[i] = nil then 261 | begin 262 | activeplats[i] := plat; 263 | Exit; 264 | end; 265 | 266 | I_Error('P_AddActivePlat(): no more plats!'); 267 | end; 268 | 269 | procedure P_RemoveActivePlat(plat: Pplat_t); 270 | var 271 | i: integer; 272 | begin 273 | for i := 0 to MAXPLATS - 1 do 274 | if plat = activeplats[i] then 275 | begin 276 | activeplats[i].sector.specialdata := nil; 277 | P_RemoveThinker(@activeplats[i].thinker); 278 | activeplats[i] := nil; 279 | Exit; 280 | end; 281 | 282 | I_Error('P_RemoveActivePlat(): can''t find plat!'); 283 | end; 284 | 285 | end. 286 | 287 | -------------------------------------------------------------------------------- /st_lib.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit st_lib; 28 | 29 | interface 30 | 31 | uses 32 | d_delphi, 33 | // We are referring to patches. 34 | r_defs; 35 | 36 | type 37 | // 38 | // Typedefs of widgets 39 | // 40 | 41 | // Number widget 42 | st_number_t = record 43 | // upper right-hand corner 44 | // of the number (right-justified) 45 | x: integer; 46 | y: integer; 47 | width: integer; // max # of digits in number 48 | oldnum: integer; // last number value 49 | num: PInteger; // pointer to current value 50 | // pointer to boolean stating 51 | // whether to update number 52 | _on: PBoolean; 53 | p: Ppatch_tPArray; // list of patches for 0-9 54 | data: integer; // user data 55 | end; 56 | Pst_number_t = ^st_number_t; 57 | 58 | // Percent widget ("child" of number widget, 59 | // or, more precisely, contains a number widget.) 60 | st_percent_t = record 61 | n: st_number_t; // number information 62 | p: Ppatch_t; // percent sign graphic 63 | end; 64 | Pst_percent_t = ^st_percent_t; 65 | 66 | // Multiple Icon widget 67 | st_multicon_t = record 68 | // center-justified location of icons 69 | x: integer; 70 | y: integer; 71 | oldinum: integer; // last icon number 72 | inum: PInteger; // pointer to current icon 73 | // pointer to boolean stating 74 | // whether to update icon 75 | _on: PBoolean; 76 | p: Ppatch_tPArray; // list of icons 77 | data: integer; // user data 78 | end; 79 | Pst_multicon_t = ^st_multicon_t; 80 | 81 | // Binary Icon widget 82 | st_binicon_t = record 83 | // center-justified location of icon 84 | x: integer; 85 | y: integer; 86 | oldval: boolean; // last icon value 87 | val: PBoolean; // pointer to current icon status 88 | // pointer to boolean 89 | // stating whether to update icon 90 | _on: PBoolean; 91 | p: Ppatch_t; // icon 92 | data: integer; // user data 93 | end; 94 | Pst_binicon_t = ^st_binicon_t; 95 | 96 | // 97 | // Widget creation, access, and update routines 98 | // 99 | 100 | // Initializes widget library. 101 | // More precisely, initialize STMINUS, 102 | // everything else is done somewhere else. 103 | procedure STlib_init; 104 | 105 | // Number widget routines 106 | procedure STlib_initNum(n: Pst_number_t; x, y: integer; pl: Ppatch_tPArray; 107 | num: PInteger; _on: PBoolean; width: integer); 108 | 109 | procedure STlib_updateNum(n: Pst_number_t; refresh: boolean); 110 | 111 | // Percent widget routines 112 | procedure STlib_initPercent(p: Pst_percent_t; x, y: integer; pl: Ppatch_tPArray; 113 | num: PInteger; _on: PBoolean; percent: Ppatch_t); 114 | 115 | procedure STlib_updatePercent(per: Pst_percent_t; refresh: boolean); 116 | 117 | // Multiple Icon widget routines 118 | procedure STlib_initMultIcon(i: Pst_multicon_t; x, y: integer; il: Ppatch_tPArray; 119 | inum: PInteger; _on: PBoolean); 120 | 121 | procedure STlib_updateMultIcon(mi: Pst_multicon_t; refresh: boolean); 122 | 123 | // Binary Icon widget routines 124 | procedure STlib_initBinIcon(b: Pst_binicon_t; x, y: integer; i: Ppatch_t; 125 | val: PBoolean; _on: PBoolean); 126 | 127 | procedure STlib_updateBinIcon(bi: Pst_binicon_t; refresh: boolean); 128 | 129 | implementation 130 | 131 | uses 132 | z_memory, 133 | v_video, 134 | i_system, 135 | w_wad, 136 | st_stuff; // automapactive 137 | 138 | // Hack display negative frags. 139 | // Loads and store the stminus lump. 140 | var 141 | sttminus: Ppatch_t; 142 | 143 | procedure STlib_init; 144 | begin 145 | sttminus := W_CacheLumpName('STTMINUS', PU_STATIC); 146 | end; 147 | 148 | procedure STlib_initNum(n: Pst_number_t; x, y: integer; pl: Ppatch_tPArray; 149 | num: PInteger; _on: PBoolean; width: integer); 150 | begin 151 | n.x := x; 152 | n.y := y; 153 | n.oldnum := 0; 154 | n.width := width; 155 | n.num := num; 156 | n._on := _on; 157 | n.p := pl; 158 | end; 159 | 160 | // A fairly efficient way to draw a number 161 | // based on differences from the old number. 162 | // Note: worth the trouble? 163 | procedure STlib_drawNum(n: Pst_number_t; refresh: boolean); 164 | var 165 | numdigits: integer; 166 | num: integer; 167 | w: integer; 168 | h: integer; 169 | x: integer; 170 | neg: boolean; 171 | begin 172 | numdigits := n.width; 173 | num := n.num^; 174 | 175 | w := n.p[0].width; 176 | h := n.p[0].height; 177 | 178 | n.oldnum := num; 179 | 180 | neg := num < 0; 181 | 182 | if neg then 183 | begin 184 | if (numdigits = 2) and (num < -9) then 185 | num := -9 186 | else if (numdigits = 3) and (num < -99) then 187 | num := -99; 188 | 189 | num := -num; 190 | end; 191 | 192 | // clear the area 193 | x := n.x - numdigits * w; 194 | 195 | if n.y - ST_Y < 0 then 196 | I_Error('STlib_drawNum() : n.y - ST_Y < 0'); 197 | 198 | V_CopyRect(x, n.y - ST_Y, SCN_ST, w * numdigits, h, x, n.y, SCN_FG, True); 199 | 200 | // if non-number, do not draw it 201 | if num = 1994 then 202 | Exit; 203 | 204 | x := n.x; 205 | 206 | // in the special case of 0, you draw 0 207 | if num = 0 then 208 | V_DrawPatch(x - w, n.y - ST_Y, SCN_ST, n.p[0], False); 209 | 210 | // draw the new number 211 | while (num <> 0) and (numdigits <> 0) do 212 | begin 213 | x := x - w; 214 | V_DrawPatch(x, n.y - ST_Y, SCN_ST, n.p[num mod 10], False); 215 | num := num div 10; 216 | dec(numdigits); 217 | end; 218 | 219 | // draw a minus sign if necessary 220 | if neg then 221 | V_DrawPatch(x - 8, n.y - ST_Y, SCN_ST, sttminus, False); 222 | end; 223 | 224 | // 225 | procedure STlib_updateNum(n: Pst_number_t; refresh: boolean); 226 | begin 227 | if n._on^ then 228 | STlib_drawNum(n, refresh); 229 | end; 230 | 231 | // 232 | procedure STlib_initPercent(p: Pst_percent_t; x, y: integer; pl: Ppatch_tPArray; 233 | num: PInteger; _on: PBoolean; percent: Ppatch_t); 234 | begin 235 | STlib_initNum(@p.n, x, y, pl, num, _on, 3); 236 | p.p := percent; 237 | end; 238 | 239 | procedure STlib_updatePercent(per: Pst_percent_t; refresh: boolean); 240 | begin 241 | if refresh and per.n._on^ then 242 | V_DrawPatch(per.n.x, per.n.y - ST_Y, SCN_ST, per.p, False); 243 | 244 | STlib_updateNum(@per.n, refresh); 245 | end; 246 | 247 | procedure STlib_initMultIcon(i: Pst_multicon_t; x, y: integer; il: Ppatch_tPArray; 248 | inum: PInteger; _on: PBoolean); 249 | begin 250 | i.x := x; 251 | i.y := y; 252 | i.oldinum := -1; 253 | i.inum := inum; 254 | i._on := _on; 255 | i.p := il; 256 | end; 257 | 258 | procedure STlib_updateMultIcon(mi: Pst_multicon_t; refresh: boolean); 259 | var 260 | y: integer; 261 | begin 262 | if mi._on^ and ((mi.oldinum <> mi.inum^) or refresh) and (mi.inum^ <> -1) then 263 | begin 264 | if mi.oldinum <> -1 then 265 | begin 266 | y := mi.y - mi.p[mi.oldinum].topoffset; 267 | 268 | if y - ST_Y < 0 then 269 | I_Error('STlib_updateMultIcon(): y - ST_Y < 0'); 270 | 271 | end; 272 | V_DrawPatch(mi.x, mi.y - ST_Y, SCN_ST, mi.p[mi.inum^], False); 273 | mi.oldinum := mi.inum^; 274 | end; 275 | end; 276 | 277 | procedure STlib_initBinIcon(b: Pst_binicon_t; x, y: integer; i: Ppatch_t; 278 | val: PBoolean; _on: PBoolean); 279 | begin 280 | b.x := x; 281 | b.y := y; 282 | b.oldval := False; 283 | b.val := val; 284 | b._on := _on; 285 | b.p := i; 286 | end; 287 | 288 | procedure STlib_updateBinIcon(bi: Pst_binicon_t; refresh: boolean); 289 | var 290 | y: integer; 291 | begin 292 | if bi._on^ and ((bi.oldval <> bi.val^) or refresh) then 293 | begin 294 | y := bi.y - bi.p.topoffset; 295 | 296 | if y - ST_Y < 0 then 297 | I_Error('STlib_updateBinIcon(): y - ST_Y < 0'); 298 | 299 | if bi.val^ then 300 | V_DrawPatch(bi.x, bi.y - ST_Y, SCN_ST, bi.p, False); 301 | 302 | bi.oldval := bi.val^; 303 | end; 304 | end; 305 | 306 | end. 307 | -------------------------------------------------------------------------------- /p_lights.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_lights; 28 | 29 | interface 30 | 31 | uses 32 | m_rnd, 33 | p_spec, 34 | r_defs, 35 | z_memory; 36 | 37 | procedure T_FireFlicker(flick: Pfireflicker_t); 38 | 39 | procedure P_SpawnFireFlicker(sector: Psector_t); 40 | 41 | procedure P_SpawnLightFlash(sector: Psector_t); 42 | 43 | procedure T_StrobeFlash(flash: Pstrobe_t); 44 | 45 | procedure P_SpawnStrobeFlash(sector: Psector_t; fastOrSlow, inSync: integer); 46 | 47 | procedure EV_StartLightStrobing(line: Pline_t); 48 | 49 | procedure EV_TurnTagLightsOff(line: Pline_t); 50 | 51 | procedure EV_LightTurnOn(line: Pline_t; bright: integer); 52 | 53 | procedure T_Glow(g: Pglow_t); 54 | 55 | procedure P_SpawnGlowingLight(sector: Psector_t); 56 | 57 | procedure T_LightFlash(flash: Plightflash_t); 58 | 59 | implementation 60 | 61 | uses 62 | p_tick, 63 | p_setup; 64 | 65 | // FIRELIGHT FLICKER 66 | 67 | // T_FireFlicker 68 | procedure T_FireFlicker(flick: Pfireflicker_t); 69 | var 70 | amount: integer; 71 | begin 72 | flick.count := flick.count - 1; 73 | if flick.count > 0 then 74 | Exit; 75 | 76 | amount := (P_Random and 3) * 16; 77 | 78 | if flick.sector.lightlevel - amount < flick.minlight then 79 | flick.sector.lightlevel := flick.minlight 80 | else 81 | flick.sector.lightlevel := flick.maxlight - amount; 82 | 83 | flick.count := 4; 84 | end; 85 | 86 | // P_SpawnFireFlicker 87 | procedure P_SpawnFireFlicker(sector: Psector_t); 88 | var 89 | flick: Pfireflicker_t; 90 | begin 91 | // Note that we are resetting sector attributes. 92 | // Nothing special about it during gameplay. 93 | sector.special := 0; 94 | 95 | flick := Z_Malloc(SizeOf(fireflicker_t), PU_LEVSPEC, nil); 96 | 97 | P_AddThinker(@flick.thinker); 98 | 99 | flick.thinker.func.acp1 := @T_FireFlicker; 100 | flick.sector := sector; 101 | flick.maxlight := sector.lightlevel; 102 | flick.minlight := P_FindMinSurroundingLight(sector, sector.lightlevel) + 16; 103 | flick.count := 4; 104 | end; 105 | 106 | // BROKEN LIGHT FLASHING 107 | 108 | // T_LightFlash 109 | // Do flashing lights. 110 | procedure T_LightFlash(flash: Plightflash_t); 111 | begin 112 | flash.count := flash.count - 1; 113 | if flash.count > 0 then 114 | Exit; 115 | 116 | if flash.sector.lightlevel = flash.maxlight then 117 | begin 118 | flash.sector.lightlevel := flash.minlight; 119 | flash.count := (P_Random and flash.mintime) + 1; 120 | end 121 | else 122 | begin 123 | flash.sector.lightlevel := flash.maxlight; 124 | flash.count := (P_Random and flash.maxtime) + 1; 125 | end; 126 | end; 127 | 128 | // P_SpawnLightFlash 129 | // After the map has been loaded, scan each sector 130 | // for specials that spawn thinkers 131 | procedure P_SpawnLightFlash(sector: Psector_t); 132 | var 133 | flash: Plightflash_t; 134 | begin 135 | // nothing special about it during gameplay 136 | sector.special := 0; 137 | 138 | flash := Z_Malloc(SizeOf(lightflash_t), PU_LEVSPEC, nil); 139 | 140 | P_AddThinker(@flash.thinker); 141 | 142 | flash.thinker.func.acp1 := @T_LightFlash; 143 | flash.sector := sector; 144 | flash.maxlight := sector.lightlevel; 145 | 146 | flash.minlight := P_FindMinSurroundingLight(sector, sector.lightlevel); 147 | flash.maxtime := 64; 148 | flash.mintime := 7; 149 | flash.count := (P_Random and flash.maxtime) + 1; 150 | end; 151 | 152 | // STROBE LIGHT FLASHING 153 | 154 | // T_StrobeFlash 155 | procedure T_StrobeFlash(flash: Pstrobe_t); 156 | begin 157 | flash.count := flash.count - 1; 158 | if flash.count > 0 then 159 | Exit; 160 | 161 | if flash.sector.lightlevel = flash.minlight then 162 | begin 163 | flash.sector.lightlevel := flash.maxlight; 164 | flash.count := flash.brighttime; 165 | end 166 | else 167 | begin 168 | flash.sector.lightlevel := flash.minlight; 169 | flash.count := flash.darktime; 170 | end; 171 | end; 172 | 173 | // P_SpawnStrobeFlash 174 | // After the map has been loaded, scan each sector 175 | // for specials that spawn thinkers 176 | procedure P_SpawnStrobeFlash(sector: Psector_t; fastOrSlow, inSync: integer); 177 | var 178 | flash: Pstrobe_t; 179 | begin 180 | flash := Z_Malloc(SizeOf(strobe_t), PU_LEVSPEC, nil); 181 | 182 | P_AddThinker(@flash.thinker); 183 | 184 | flash.sector := sector; 185 | flash.darktime := fastOrSlow; 186 | flash.brighttime := STROBEBRIGHT; 187 | flash.thinker.func.acp1 := @T_StrobeFlash; 188 | flash.maxlight := sector.lightlevel; 189 | flash.minlight := P_FindMinSurroundingLight(sector, sector.lightlevel); 190 | 191 | if flash.minlight = flash.maxlight then 192 | flash.minlight := 0; 193 | 194 | // nothing special about it during gameplay 195 | sector.special := 0; 196 | 197 | if inSync = 0 then 198 | flash.count := (P_Random and 7) + 1 199 | else 200 | flash.count := 1; 201 | end; 202 | 203 | // Start strobing lights (usually from a trigger) 204 | procedure EV_StartLightStrobing(line: Pline_t); 205 | var 206 | secnum: integer; 207 | sec: Psector_t; 208 | begin 209 | secnum := -1; 210 | repeat 211 | secnum := P_FindSectorFromLineTag(line, secnum); 212 | 213 | if secnum >= 0 then 214 | begin 215 | sec := @sectors[secnum]; 216 | if sec.specialdata = nil then 217 | P_SpawnStrobeFlash(sec, SLOWDARK, 0); 218 | end; 219 | until secnum < 0; 220 | end; 221 | 222 | // TURN LINE'S TAG LIGHTS OFF 223 | procedure EV_TurnTagLightsOff(line: Pline_t); 224 | var 225 | i: integer; 226 | j: integer; 227 | min: integer; 228 | sector: Psector_t; 229 | tsec: Psector_t; 230 | templine: Pline_t; 231 | begin 232 | for i := 0 to numsectors - 1 do 233 | begin 234 | sector := @sectors[i]; 235 | if sector.tag = line.tag then 236 | begin 237 | min := sector.lightlevel; 238 | for j := 0 to sector.linecount - 1 do 239 | begin 240 | templine := sector.lines[j]; 241 | tsec := getNextSector(templine, sector); 242 | if tsec <> nil then 243 | begin 244 | if tsec.lightlevel < min then 245 | min := tsec.lightlevel; 246 | end; 247 | end; 248 | sector.lightlevel := min; 249 | end; 250 | end; 251 | end; 252 | 253 | // TURN LINE'S TAG LIGHTS ON 254 | procedure EV_LightTurnOn(line: Pline_t; bright: integer); 255 | var 256 | i: integer; 257 | j: integer; 258 | sector: Psector_t; 259 | temp: Psector_t; 260 | templine: Pline_t; 261 | begin 262 | for i := 0 to numsectors - 1 do 263 | begin 264 | sector := @sectors[i]; 265 | if sector.tag = line.tag then 266 | begin 267 | // bright = 0 means to search 268 | // for highest light level 269 | // surrounding sector 270 | if bright = 0 then 271 | begin 272 | for j := 0 to sector.linecount - 1 do 273 | begin 274 | templine := sector.lines[j]; 275 | temp := getNextSector(templine, sector); 276 | if temp <> nil then 277 | begin 278 | if temp.lightlevel > bright then 279 | bright := temp.lightlevel; 280 | end; 281 | end; 282 | end; 283 | sector.lightlevel := bright; 284 | end; 285 | end; 286 | end; 287 | 288 | // Spawn glowing light 289 | procedure T_Glow(g: Pglow_t); 290 | begin 291 | case g.direction of 292 | -1: 293 | begin 294 | // DOWN 295 | g.sector.lightlevel := g.sector.lightlevel - GLOWSPEED; 296 | if g.sector.lightlevel <= g.minlight then 297 | begin 298 | g.sector.lightlevel := g.sector.lightlevel + GLOWSPEED; 299 | g.direction := 1; 300 | end; 301 | end; 302 | 1: 303 | begin 304 | // UP 305 | g.sector.lightlevel := g.sector.lightlevel + GLOWSPEED; 306 | if g.sector.lightlevel >= g.maxlight then 307 | begin 308 | g.sector.lightlevel := g.sector.lightlevel - GLOWSPEED; 309 | g.direction := -1; 310 | end; 311 | end; 312 | end; 313 | end; 314 | 315 | procedure P_SpawnGlowingLight(sector: Psector_t); 316 | var 317 | g: Pglow_t; 318 | begin 319 | g := Z_Malloc(SizeOf(glow_t), PU_LEVSPEC, nil); 320 | 321 | P_AddThinker(@g.thinker); 322 | 323 | g.sector := sector; 324 | g.minlight := P_FindMinSurroundingLight(sector, sector.lightlevel); 325 | g.maxlight := sector.lightlevel; 326 | g.thinker.func.acp1 := @T_Glow; 327 | g.direction := -1; 328 | 329 | sector.special := 0; 330 | end; 331 | 332 | end. 333 | -------------------------------------------------------------------------------- /p_sight.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit p_sight; 28 | 29 | interface 30 | 31 | uses 32 | m_fixed, 33 | p_mobj_h; 34 | 35 | function P_CheckSight(t1: Pmobj_t; t2: Pmobj_t): boolean; 36 | 37 | var 38 | bottomslope: fixed_t; // slopes to top and bottom of target 39 | topslope: fixed_t; 40 | 41 | implementation 42 | 43 | uses 44 | d_delphi, 45 | doomdata, 46 | p_local, 47 | p_setup, 48 | r_defs, 49 | r_main; 50 | 51 | // P_CheckSight 52 | var 53 | sightzstart: fixed_t; // eye z of looker 54 | 55 | strace: divline_t; // from t1 to t2 56 | t2x: fixed_t; 57 | t2y: fixed_t; 58 | 59 | // P_DivlineSide 60 | // Returns side 0 (front), 1 (back), or 2 (on). 61 | function P_DivlineSide(x, y: fixed_t; node: Pdivline_t): integer; 62 | var 63 | dx: fixed_t; 64 | dy: fixed_t; 65 | left: fixed_t; 66 | right: fixed_t; 67 | begin 68 | if node.dx = 0 then 69 | begin 70 | if x = node.x then 71 | begin 72 | Result := 2; 73 | Exit; 74 | end; 75 | if x <= node.x then 76 | begin 77 | if node.dy > 0 then 78 | Result := 1 79 | else 80 | Result := 0; 81 | Exit; 82 | end; 83 | if node.dy < 0 then 84 | Result := 1 85 | else 86 | Result := 0; 87 | Exit; 88 | end; 89 | 90 | if node.dy = 0 then 91 | begin 92 | if x = node.y then 93 | begin 94 | Result := 2; 95 | Exit; 96 | end; 97 | if y <= node.y then 98 | begin 99 | if node.dx < 0 then 100 | Result := 1 101 | else 102 | Result := 0; 103 | Exit; 104 | end; 105 | if node.dx > 0 then 106 | Result := 1 107 | else 108 | Result := 0; 109 | Exit; 110 | end; 111 | 112 | dx := (x - node.x); 113 | dy := (y - node.y); 114 | 115 | left := _SHR(node.dy, FRACBITS) * _SHR(dx, FRACBITS); 116 | right := _SHR(dy, FRACBITS) * _SHR(node.dx, FRACBITS); 117 | 118 | if right < left then 119 | begin 120 | Result := 0; // front side 121 | Exit; 122 | end; 123 | 124 | if left = right then 125 | Result := 2 126 | else 127 | Result := 1; // back side 128 | end; 129 | 130 | // P_InterceptVector2 131 | // Returns the fractional intercept point 132 | // along the first divline. 133 | // This is only called by the addthings and addlines traversers. 134 | function P_InterceptVector2(v2, v1: Pdivline_t): fixed_t; 135 | var 136 | num: fixed_t; 137 | den: fixed_t; 138 | begin 139 | den := FixedMul(_SHR(v1.dy, 8), v2.dx) - FixedMul(_SHR(v1.dx, 8), v2.dy); 140 | 141 | if den = 0 then 142 | begin 143 | Result := 0; 144 | Exit; 145 | end; 146 | 147 | num := FixedMul(_SHR(v1.x - v2.x, 8), v1.dy) + 148 | FixedMul(_SHR(v2.y - v1.y, 8), v1.dx); 149 | 150 | Result := FixedDiv(num, den); 151 | end; 152 | 153 | // P_CrossSubsector 154 | // Returns True 155 | // if strace crosses the given subsector successfully. 156 | function P_CrossSubsector(num: integer): boolean; 157 | var 158 | seg: Pseg_t; 159 | line: Pline_t; 160 | s1: integer; 161 | s2: integer; 162 | i: integer; 163 | sub: Psubsector_t; 164 | front: Psector_t; 165 | back: Psector_t; 166 | opentop: fixed_t; 167 | openbottom: fixed_t; 168 | divl: divline_t; 169 | v1: Pvertex_t; 170 | v2: Pvertex_t; 171 | frac: fixed_t; 172 | slope: fixed_t; 173 | begin 174 | sub := @subsectors[num]; 175 | 176 | // check lines 177 | for i := sub.firstline to sub.firstline + sub.numlines - 1 do 178 | begin 179 | seg := @segs[i]; 180 | line := seg.linedef; 181 | 182 | // allready checked other side? 183 | if line.validcount = validcount then 184 | Continue; 185 | 186 | line.validcount := validcount; 187 | 188 | v1 := line.v1; 189 | v2 := line.v2; 190 | s1 := P_DivlineSide(v1.x, v1.y, @strace); 191 | s2 := P_DivlineSide(v2.x, v2.y, @strace); 192 | 193 | // line isn't crossed? 194 | if s1 = s2 then 195 | Continue; 196 | 197 | divl.x := v1.x; 198 | divl.y := v1.y; 199 | divl.dx := v2.x - v1.x; 200 | divl.dy := v2.y - v1.y; 201 | s1 := P_DivlineSide(strace.x, strace.y, @divl); 202 | s2 := P_DivlineSide(t2x, t2y, @divl); 203 | 204 | // line isn't crossed? 205 | if s1 = s2 then 206 | Continue; 207 | 208 | // stop because it is not two sided anyway 209 | // might do this after updating validcount? 210 | if line.flags and ML_TWOSIDED = 0 then 211 | begin 212 | Result := False; 213 | Exit; 214 | end; 215 | 216 | // crosses a two sided line 217 | front := seg.frontsector; 218 | back := seg.backsector; 219 | 220 | // no wall to block sight with? 221 | if (front.floorheight = back.floorheight) and 222 | (front.ceilingheight = back.ceilingheight) then 223 | Continue; 224 | 225 | // possible occluder 226 | // because of ceiling height differences 227 | if front.ceilingheight < back.ceilingheight then 228 | opentop := front.ceilingheight 229 | else 230 | opentop := back.ceilingheight; 231 | 232 | // because of ceiling height differences 233 | if front.floorheight > back.floorheight then 234 | openbottom := front.floorheight 235 | else 236 | openbottom := back.floorheight; 237 | 238 | // quick test for totally closed doors 239 | if openbottom >= opentop then 240 | begin 241 | Result := False; // stop 242 | Exit; 243 | end; 244 | 245 | frac := P_InterceptVector2(@strace, @divl); 246 | 247 | if front.floorheight <> back.floorheight then 248 | begin 249 | slope := FixedDiv(openbottom - sightzstart, frac); 250 | if slope > bottomslope then 251 | bottomslope := slope; 252 | end; 253 | 254 | if front.ceilingheight <> back.ceilingheight then 255 | begin 256 | slope := FixedDiv(opentop - sightzstart, frac); 257 | if slope < topslope then 258 | topslope := slope; 259 | end; 260 | 261 | if topslope <= bottomslope then 262 | begin 263 | Result := False; // stop 264 | Exit; 265 | end; 266 | end; 267 | 268 | // passed the subsector ok 269 | Result := True; 270 | end; 271 | 272 | // P_CrossBSPNode 273 | // Returns True 274 | // if strace crosses the given node successfully. 275 | function P_CrossBSPNode(bspnum: integer): boolean; 276 | var 277 | bsp: Pnode_t; 278 | side: integer; 279 | begin 280 | if bspnum and NF_SUBSECTOR <> 0 then 281 | begin 282 | if bspnum = -1 then 283 | Result := P_CrossSubsector(0) 284 | else 285 | Result := P_CrossSubsector(bspnum and not NF_SUBSECTOR); 286 | Exit; 287 | end; 288 | 289 | bsp := @nodes[bspnum]; 290 | 291 | // decide which side the start point is on 292 | side := P_DivlineSide(strace.x, strace.y, Pdivline_t(bsp)); 293 | if side = 2 then 294 | side := 0; // an "on" should cross both sides 295 | 296 | // cross the starting side 297 | if not P_CrossBSPNode(bsp.children[side]) then 298 | begin 299 | Result := False; 300 | Exit; 301 | end; 302 | 303 | // the partition plane is crossed here 304 | if side = P_DivlineSide(t2x, t2y, Pdivline_t(bsp)) then 305 | begin 306 | // the line doesn't touch the other side 307 | Result := True; 308 | Exit; 309 | end; 310 | 311 | // cross the ending side 312 | Result := P_CrossBSPNode(bsp.children[side xor 1]); 313 | end; 314 | 315 | // P_CheckSight 316 | // Returns True 317 | // if a straight line between t1 and t2 is unobstructed. 318 | // Uses REJECT. 319 | function P_CheckSight(t1: Pmobj_t; t2: Pmobj_t): boolean; 320 | var 321 | s1: integer; 322 | s2: integer; 323 | pnum: integer; 324 | bytenum: integer; 325 | bitnum: integer; 326 | begin 327 | // First check for trivial rejection. 328 | 329 | // Determine subsector entries in REJECT table. 330 | s1 := pOperation(Psubsector_t(t1.subsector).sector, @sectors[0], 331 | '-', SizeOf(sectors[0])); 332 | s2 := pOperation(Psubsector_t(t2.subsector).sector, @sectors[0], 333 | '-', SizeOf(sectors[0])); 334 | pnum := s1 * numsectors + s2; 335 | bytenum := _SHR(pnum, 3); 336 | bitnum := 1 shl (pnum and 7); 337 | 338 | // Check in REJECT table. 339 | if rejectmatrix[bytenum] and bitnum <> 0 then 340 | begin 341 | // can't possibly be connected 342 | Result := False; 343 | Exit; 344 | end; 345 | 346 | // An unobstructed LOS is possible. 347 | // Now look from eyes of t1 to any part of t2. 348 | Inc(validcount); 349 | 350 | sightzstart := t1.z + t1.height - _SHR(t1.height, 2); 351 | topslope := (t2.z + t2.height) - sightzstart; 352 | bottomslope := t2.z - sightzstart; 353 | 354 | strace.x := t1.x; 355 | strace.y := t1.y; 356 | t2x := t2.x; 357 | t2y := t2.y; 358 | strace.dx := t2.x - t1.x; 359 | strace.dy := t2.y - t1.y; 360 | 361 | // the head node is the last node output 362 | Result := P_CrossBSPNode(numnodes - 1); 363 | end; 364 | 365 | end. 366 | 367 | -------------------------------------------------------------------------------- /r_plane.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // DoomXS - A basic Windows source port of Doom 4 | // based on original Linux Doom as published by "id Software" 5 | // Copyright (C) 1993-1996 by id Software, Inc. 6 | // Copyright (C) 2021-2022 by Jim Valavanis 7 | // 8 | // This program is free software; you can redistribute it and/or 9 | // modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation; either version 2 11 | // of the License, or (at your option) any later version. 12 | // 13 | // This program is distributed in the hope that it will be useful, 14 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | // 18 | // You should have received a copy of the GNU General Public License 19 | // along with this program; if not, write to the Free Software 20 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 | // 02111-1307, USA. 22 | // 23 | //------------------------------------------------------------------------------ 24 | // Site: https://sourceforge.net/projects/doomxs/ 25 | //------------------------------------------------------------------------------ 26 | 27 | unit r_plane; 28 | 29 | interface 30 | 31 | uses 32 | m_fixed, 33 | doomdef, 34 | r_data, 35 | r_defs; 36 | 37 | procedure R_ClearPlanes; 38 | 39 | procedure R_MapPlane(y: integer; x1: integer; x2: integer); 40 | 41 | procedure R_MakeSpans(x: integer; t1: integer; b1: integer; t2: integer; b2: integer); 42 | 43 | procedure R_DrawPlanes; 44 | 45 | function R_FindPlane(height: fixed_t; picnum: integer; lightlevel: integer): Pvisplane_t; 46 | 47 | function R_CheckPlane(pl: Pvisplane_t; start: integer; stop: integer): Pvisplane_t; 48 | 49 | var 50 | // 51 | // Clip values are the solid pixel bounding the range. 52 | // floorclip starts out SCREENHEIGHT 53 | // ceilingclip starts out -1 54 | // 55 | floorclip: packed array[0..SCREENWIDTH - 1] of smallint; 56 | ceilingclip: packed array[0..SCREENWIDTH - 1] of smallint; 57 | 58 | var 59 | floorplane: Pvisplane_t; 60 | ceilingplane: Pvisplane_t; 61 | 62 | const 63 | MAXOPENINGS = SCREENWIDTH * SCREENHEIGHT; //https://www.doomworld.com/vb/source-ports/85967-reasonable-static-limit-for-maxopenings/ 64 | 65 | var 66 | openings: packed array[0..MAXOPENINGS - 1] of smallint; 67 | lastopening: integer; 68 | 69 | yslope: array[0..SCREENHEIGHT - 1] of fixed_t; 70 | distscale: array[0..SCREENWIDTH - 1] of fixed_t; 71 | 72 | implementation 73 | 74 | uses 75 | d_delphi, 76 | tables, 77 | i_system, 78 | r_sky, 79 | r_draw, 80 | r_main, 81 | r_things, 82 | z_memory, 83 | w_wad; 84 | 85 | // Here comes the obnoxious "visplane". 86 | const 87 | MAXVISPLANES = 256; // JVAL was = 128 88 | 89 | var 90 | visplanes: array[0..MAXVISPLANES - 1] of visplane_t; 91 | lastvisplane: integer; 92 | 93 | // spanstart holds the start of a plane span 94 | // initialized to 0 at start 95 | spanstart: array[0..SCREENHEIGHT - 1] of integer; 96 | 97 | // texture mapping 98 | planezlight: Plighttable_tPArray; 99 | planeheight: fixed_t; 100 | 101 | basexscale: fixed_t; 102 | baseyscale: fixed_t; 103 | 104 | // 105 | // R_MapPlane 106 | // 107 | // Uses global vars: 108 | // planeheight 109 | // ds_source 110 | // basexscale 111 | // baseyscale 112 | // viewx 113 | // viewy 114 | // 115 | // BASIC PRIMITIVE 116 | // 117 | procedure R_MapPlane(y: integer; x1: integer; x2: integer); 118 | var 119 | angle: angle_t; 120 | distance: fixed_t; 121 | len: fixed_t; 122 | index: LongWord; 123 | slope: Double; 124 | begin 125 | slope := (planeheight / abs(centery - y)) * planerelativeaspect; 126 | distance := FixedMul(planeheight, yslope[y]); 127 | ds_xstep := Round(viewsin * slope / FRACUNIT); 128 | ds_ystep := Round(viewcos * slope / FRACUNIT); 129 | 130 | len := FixedMul(distance, distscale[x1]); 131 | angle := (viewangle + xtoviewangle[x1]) shr ANGLETOFINESHIFT; 132 | ds_xfrac := viewx + FixedMul(finecosine[angle], len); 133 | ds_yfrac := -viewy - FixedMul(finesine[angle], len); 134 | 135 | if fixedcolormap <> nil then 136 | ds_colormap := fixedcolormap 137 | else 138 | begin 139 | index := _SHR(distance, LIGHTZSHIFT); 140 | 141 | if index >= MAXLIGHTZ then 142 | index := MAXLIGHTZ - 1; 143 | 144 | ds_colormap := planezlight[index]; 145 | end; 146 | 147 | ds_y := y; 148 | ds_x1 := x1; 149 | ds_x2 := x2; 150 | 151 | // high or low detail 152 | spanfunc; 153 | end; 154 | 155 | // R_ClearPlanes 156 | // At begining of frame. 157 | procedure R_ClearPlanes; 158 | var 159 | i: integer; 160 | angle: angle_t; 161 | begin 162 | // opening / clipping determination 163 | for i := 0 to viewwidth - 1 do 164 | begin 165 | floorclip[i] := viewheight; 166 | ceilingclip[i] := -1; 167 | end; 168 | 169 | lastvisplane := 0; 170 | lastopening := 0; 171 | 172 | // left to right mapping 173 | angle := (viewangle - ANG90) shr ANGLETOFINESHIFT; 174 | 175 | // scale will be unit scale at SCREENWIDTH/2 distance 176 | basexscale := FixedDiv(finecosine[angle], centerxfrac); 177 | baseyscale := -FixedDiv(finesine[angle], centerxfrac); 178 | end; 179 | 180 | // R_NewVisPlane 181 | function R_NewVisPlane: integer; 182 | begin 183 | if lastvisplane = MAXVISPLANES then 184 | I_Error('R_NewVisPlane(): no more visplanes'); 185 | 186 | if lastvisplane > maxvisplane then 187 | begin 188 | visplanes[lastvisplane].top := 189 | Z_Malloc((SCREENWIDTH + 2) * SizeOf(visindex_t), PU_LEVEL, nil); 190 | visplanes[lastvisplane].bottom := 191 | Z_Malloc((SCREENWIDTH + 2) * SizeOf(visindex_t), PU_LEVEL, nil); 192 | maxvisplane := lastvisplane; 193 | end; 194 | 195 | inc(lastvisplane); 196 | Result := lastvisplane; 197 | end; 198 | 199 | // R_FindPlane 200 | function R_FindPlane(height: fixed_t; picnum: integer; lightlevel: integer): Pvisplane_t; 201 | var 202 | check: integer; 203 | i: integer; 204 | begin 205 | if picnum = skyflatnum then 206 | begin 207 | height := 0; // all skys map together 208 | lightlevel := 0; 209 | end; 210 | 211 | check := 0; 212 | while check < lastvisplane do 213 | begin 214 | if (height = visplanes[check].height) and 215 | (picnum = visplanes[check].picnum) and 216 | (lightlevel = visplanes[check].lightlevel) then 217 | Break; 218 | inc(check); 219 | end; 220 | 221 | if check < lastvisplane then 222 | begin 223 | Result := @visplanes[check]; 224 | Exit; 225 | end; 226 | 227 | if lastvisplane = MAXVISPLANES then 228 | I_Error('R_FindPlane(): no more visplanes'); 229 | 230 | lastvisplane := R_NewVisPlane; 231 | 232 | Result := @visplanes[check]; 233 | Result.height := height; 234 | Result.picnum := picnum; 235 | Result.lightlevel := lightlevel; 236 | Result.minx := SCREENWIDTH; 237 | Result.maxx := -1; 238 | 239 | for i := 0 to SCREENWIDTH - 1 do 240 | Result.top[i] := VISEND; 241 | end; 242 | 243 | // R_CheckPlane 244 | function R_CheckPlane(pl: Pvisplane_t; start: integer; stop: integer): Pvisplane_t; 245 | var 246 | intrl: integer; 247 | intrh: integer; 248 | unionl: integer; 249 | unionh: integer; 250 | x: integer; 251 | i: integer; 252 | begin 253 | if start < pl.minx then 254 | begin 255 | intrl := pl.minx; 256 | unionl := start; 257 | end 258 | else 259 | begin 260 | unionl := pl.minx; 261 | intrl := start; 262 | end; 263 | 264 | if stop > pl.maxx then 265 | begin 266 | intrh := pl.maxx; 267 | unionh := stop; 268 | end 269 | else 270 | begin 271 | unionh := pl.maxx; 272 | intrh := stop; 273 | end; 274 | 275 | x := intrl; 276 | while x <= intrh do 277 | begin 278 | if pl.top[x] <> VISEND then 279 | Break 280 | else 281 | inc(x); 282 | end; 283 | 284 | if x > intrh then 285 | begin 286 | pl.minx := unionl; 287 | pl.maxx := unionh; 288 | 289 | // use the same one 290 | Result := pl; 291 | Exit; 292 | end; 293 | 294 | // make a new visplane 295 | if lastvisplane = MAXVISPLANES then 296 | I_Error('R_CheckPlane(): no more visplanes'); 297 | 298 | Result := @visplanes[lastvisplane]; 299 | Result.height := pl.height; 300 | Result.picnum := pl.picnum; 301 | Result.lightlevel := pl.lightlevel; 302 | 303 | lastvisplane := R_NewVisPlane; 304 | 305 | Result.minx := start; 306 | Result.maxx := stop; 307 | 308 | for i := 0 to SCREENWIDTH - 1 do 309 | Result.top[i] := VISEND; 310 | end; 311 | 312 | // R_MakeSpans 313 | procedure R_MakeSpans(x: integer; t1: integer; b1: integer; t2: integer; b2: integer); 314 | begin 315 | while (t1 < t2) and (t1 <= b1) do 316 | begin 317 | if (t1 >= 0) and (t1 < viewheight) then 318 | R_MapPlane(t1, spanstart[t1], x - 1); 319 | inc(t1); 320 | end; 321 | while (b1 > b2) and (b1 >= t1) do 322 | begin 323 | if (b1 >= 0) and (b1 < viewheight) then 324 | R_MapPlane(b1, spanstart[b1], x - 1); 325 | dec(b1); 326 | end; 327 | 328 | while (t2 < t1) and (t2 <= b2) do 329 | begin 330 | if (t2 >= 0) and (t2 < viewheight) then 331 | spanstart[t2] := x; 332 | inc(t2); 333 | end; 334 | while (b2 > b1) and (b2 >= t2) do 335 | begin 336 | if (b2 >= 0) and (b2 < viewheight) then 337 | spanstart[b2] := x; 338 | dec(b2); 339 | end; 340 | end; 341 | 342 | // R_DrawPlanes 343 | // At the end of each frame. 344 | procedure R_DrawPlanes; 345 | var 346 | pl: Pvisplane_t; 347 | i: integer; 348 | light: integer; 349 | x: integer; 350 | stop: integer; 351 | angle: integer; 352 | begin 353 | for i := 0 to lastvisplane - 1 do 354 | begin 355 | pl := @visplanes[i]; 356 | if pl.minx > pl.maxx then 357 | Continue; 358 | 359 | // sky flat 360 | if pl.picnum = skyflatnum then 361 | begin 362 | dc_iscale := pspriteiscale; 363 | 364 | // Sky is allways drawn full bright, 365 | // i.e. colormaps[0] is used. 366 | // Because of this hack, sky is not affected 367 | // by INVUL inverse mapping. 368 | dc_colormap := colormaps; 369 | dc_texturemid := skytexturemid; 370 | for x := pl.minx to pl.maxx do 371 | begin 372 | dc_yl := pl.top[x]; 373 | dc_yh := pl.bottom[x]; 374 | 375 | if dc_yl <= dc_yh then 376 | begin 377 | angle := _SHR(viewangle + xtoviewangle[x], ANGLETOSKYSHIFT); 378 | dc_x := x; 379 | dc_source := R_GetColumn(skytexture, angle); 380 | // JVAL: call skycolfunc(), not colfunc() 381 | skycolfunc; 382 | end; 383 | end; 384 | Continue; 385 | end; 386 | 387 | // regular flat 388 | ds_source := W_CacheLumpNum(firstflat + flattranslation[pl.picnum], PU_STATIC); 389 | 390 | planeheight := abs(pl.height - viewz); 391 | light := _SHR(pl.lightlevel, LIGHTSEGSHIFT) + extralight; 392 | 393 | if light >= LIGHTLEVELS then 394 | light := LIGHTLEVELS - 1 395 | else if light < 0 then 396 | light := 0; 397 | 398 | planezlight := @zlight[light]; 399 | 400 | pl.top[pl.maxx + 1] := VISEND; 401 | pl.top[pl.minx - 1] := VISEND; 402 | 403 | stop := pl.maxx + 1; 404 | 405 | for x := pl.minx to stop do 406 | R_MakeSpans(x, pl.top[x - 1], pl.bottom[x - 1], pl.top[x], pl.bottom[x]); 407 | 408 | Z_ChangeTag(ds_source, PU_CACHE); 409 | end; 410 | end; 411 | 412 | end. 413 | 414 | --------------------------------------------------------------------------------