├── Readme.md ├── differences.md ├── documentation ├── DOOM_Sound.mp4 ├── HUD.png ├── Hanger_Finished.gif ├── Menu_first.gif ├── Menu_til_start.gif ├── WAD_Viewer_001.png ├── am_map_finished.gif ├── am_map_normal.gif ├── doom.png ├── e1m1_100.png ├── e1m2.png ├── finish_screen.png ├── first_app_rendering.png ├── invisible.png ├── open_door.gif ├── raise_pistol.gif ├── rotate.gif ├── shoot_barrel.gif ├── sprites.png ├── very_first_screenrender.png ├── walking.gif ├── wipe.gif └── with_flats.png ├── doom_vs_lcl.md ├── lessons_learned.md ├── license.md └── src ├── WAD_Viewer ├── project1.lpi ├── project1.lpr ├── unit1.lfm ├── unit1.pas ├── unit2.lfm ├── unit2.pas ├── unit3.lfm ├── unit3.pas ├── unit4.lfm ├── unit4.pas ├── unit5.lfm ├── unit5.pas ├── unit6.lfm ├── unit6.pas ├── uwad_viewer.pas └── uwave.pas ├── fpc_doom.lpi ├── fpc_doom.lpr ├── ufpc_doom_bass.pas ├── ufpc_doom_types.pas ├── unit1.lfm ├── unit1.pas └── units ├── a11y_weapon_pspr.pas ├── am_map.pas ├── config.pas ├── d_englsh.pas ├── d_event.pas ├── d_items.pas ├── d_iwad.pas ├── d_loop.pas ├── d_main.pas ├── d_mode.pas ├── d_net.pas ├── d_player.pas ├── d_pwad.pas ├── d_think.pas ├── d_ticcmd.pas ├── deh_doom.pas ├── deh_main.pas ├── deh_misc.pas ├── deh_ptr.pas ├── deh_thing.pas ├── doom_icon.pas ├── doomdata.pas ├── doomdef.pas ├── doomkey.pas ├── doomstat.pas ├── doomtype.pas ├── dstrings.pas ├── f_finale.pas ├── f_wipe.pas ├── g_game.pas ├── hu_lib.pas ├── hu_stuff.pas ├── i_sdlsound.pas ├── i_sound.pas ├── i_system.pas ├── i_timer.pas ├── i_video.pas ├── info.pas ├── info_types.pas ├── m_argv.pas ├── m_bbox.pas ├── m_cheat.pas ├── m_config.pas ├── m_controls.pas ├── m_fixed.pas ├── m_menu.pas ├── m_misc.pas ├── m_random.pas ├── net_client.pas ├── net_defs.pas ├── p_bexptr.pas ├── p_blockmap.pas ├── p_ceilng.pas ├── p_doors.pas ├── p_enemy.pas ├── p_extnodes.pas ├── p_floor.pas ├── p_inter.pas ├── p_lights.pas ├── p_local.pas ├── p_map.pas ├── p_maputl.pas ├── p_mobj.pas ├── p_plats.pas ├── p_pspr.pas ├── p_saveg.pas ├── p_setup.pas ├── p_sight.pas ├── p_spec.pas ├── p_switch.pas ├── p_telept.pas ├── p_tick.pas ├── p_user.pas ├── r_bmaps.pas ├── r_bsp.pas ├── r_data.pas ├── r_defs.pas ├── r_draw.pas ├── r_main.pas ├── r_plane.pas ├── r_segs.pas ├── r_sky.pas ├── r_swirl.pas ├── r_things.pas ├── s_musinfo.pas ├── s_sound.pas ├── sounds.pas ├── st_lib.pas ├── st_stuff.pas ├── statdump.pas ├── tables.pas ├── ufifo.pas ├── usdl_wrapper.pas ├── v_diskicon.pas ├── v_patch.pas ├── v_snow.pas ├── v_trans.pas ├── v_video.pas ├── w_file.pas ├── w_main.pas ├── w_wad.pas ├── wi_stuff.pas └── z_zone.pas /Readme.md: -------------------------------------------------------------------------------- 1 | # FPC DOOM 2 | 3 | In this repository i try to port DOOM to Free-Pascal using OpenGL and therefore beeing platform indipendant. 4 | 5 | > !! Attention !! 6 | > 7 | > This is a work in progress, the game is already playable, but not everything is ported. 8 | > Its highly recommended to play with debugger and Lazarus-IDE. 9 | > If you get a "Port me." exception, you reached the end of the actual porting progress. 10 | 11 | The original code was released by [id-Software](https://github.com/id-Software/DOOM) unfortunatunelly 12 | i was not able to get the code compiled, so i decided to use the 13 | [crispy-doom](https://github.com/fabiangreffrath/crispy-doom) version as base (as this one directly compiled 14 | and was able to start and play the .wad files i have had laying around). 15 | 16 | Also i found some usefull documentations that try to explain the code: 17 | - https://fabiensanglard.net/doomIphone/doomClassicRenderer.php 18 | - https://doomwiki.org/wiki/Doom_source_code 19 | - https://doom.fandom.com/wiki/Doom_source_code 20 | - https://doom.fandom.com/wiki/Doom_source_code_files 21 | - https://www.youtube.com/watch?v=cqL3jvlU61c&themeRefresh=1 22 | 23 | There is already a [FPC Doom](https://github.com/jval1972/FPCDoom) on the [List](https://doomwiki.org/wiki/Source_port) of 24 | ports, but that version only supports DirectX and therefore only supports Windows platform. 25 | 26 | ## What needs to be done to compile the code 27 | 28 | - install [Lazarus-IDE](https://www.lazarus-ide.org/) 29 | - install package LazOpenGLContext (is shipped with lazarus) 30 | - download [dglOpenGL.pas](https://github.com/saschawillems/dglopengl) and store it in the units folder 31 | - download [bass](https://www.un4seen.com) and store bass.pas in the units folder 32 | 33 | o Windows users: 34 | - copy bass.dll into root folder 35 | 36 | o Linux users: 37 | - copy libbass.so to /usr/lib 38 | - chmod o+r it 39 | 40 | ## What needs to be done to play the game 41 | 42 | - get a valid .wad file and copy it where the binary is beeing created (or use this [shareware](https://www.doomworld.com/3ddownloads/ports/shareware_doom_iwad.zip) version) 43 | - read carefull the above hint and see section [progress](#progress) 44 | - Download and install bass (see [What needs to be done to compile the code](#what-needs-to-be-done-to-compile-the-code)) 45 | - start the application (at best using the Lazarus IDE) 46 | 47 | ## Lessons learned ? 48 | 49 | As this section is not interesting for everyone i extracted this into a separate section [lessons learned](lessons_learned.md). 50 | Furthermore there are some special points when porting a "old" DOS application to a modern "Linux/Windows" application, which i handle in the section [DOOM vs. LCL](doom_vs_lcl.md). 51 | 52 | ## Difference to other source ports and key mappings 53 | 54 | As i am not doing a 100% source port but more a port for me and my education (or personal needs), FPC DOOM will not be like Vanilla DOOM and even not like Crispy DOOM. To See the differences look [here](differences.md). 55 | 56 | ## Known Bugs 57 | - Replaying of demo's does not work because the time is "glichting" away during simulation 58 | - not really a bug, but savegames are not onderstood, thus atm not available. 59 | 60 | ## Progress: 61 | 64 | - got crispy-doom compiled 65 | - created initial FPC_DOOM Lazarus project 66 | - (2025.01.03) stored everything on Github 67 | - able to extract icon from doom_icon.pas 68 | - w_wad.pas can now "load" the .wad file 69 | - (2025.01.09) able to store "patches" when drawn as .bmp files to harddisc, very first extracted image "M_DOOM" ![](documentation/doom.png) 70 | - (2025.01.10) activate OpenGL Rendering default upscale = 2 ![](documentation/first_app_rendering.png) 71 | - (2025.01.12) integrate keyboard event loop and main menu with quit button ![](documentation/Menu_first.gif) 72 | - (2025.01.13) finish part of menues necessary to actually start a game ![](documentation/Menu_til_start.gif) 73 | - (2025.01.20) finish wipe function ![](documentation/wipe.gif) 74 | - (2025.01.22) able to create very first screenrendering ![](documentation/very_first_screenrender.png)
still missing flats.. 75 | - (2025.01.23) finally was able to enable flats ![](documentation/with_flats.png) 76 | - (2025.01.24) add ability to rotate player, lets take a shy look around ;) ![](documentation/rotate.gif) 77 | - (2025.01.25) enable sprite rendering ![](documentation/sprites.png) 78 | - (2025.01.26) give the player a weapon ![](documentation/raise_pistol.gif)
still not able to shoot or move :( 79 | - (2025.01.28) enable "normal" map preview ![](documentation/am_map_normal.gif) 80 | - (2025.01.29) enable am map cheats, and finished am functions ![](documentation/am_map_finished.gif) 81 | - (2025.01.30) enable forward walking and falling ![](documentation/walking.gif)
still no strafe / clipping or interaction with the map 82 | - (2025.02.01) enable interaction with doors ![](documentation/open_door.gif) 83 | - (2025.02.03) able to shoot barrels ![](documentation/shoot_barrel.gif) 84 | - (2025.02.05) First version of .wad viewer ![](documentation/WAD_Viewer_001.png) 85 | - (2025.02.06) enable SFX engine [Video](documentation/DOOM_Sound.mp4) 86 | - (2025.02.08) reached finish screen of level 1 ![](documentation/Hanger_Finished.gif) 87 | - (2025.02.09) reached level 2 ![](documentation/e1m2.png)
still no HUD and not all secrets in level 1 possible 88 | - (2025.02.11) finally ported everything to play e1m1 with 100% (kills, items, secret) without using cheat codes ![](documentation/e1m1_100.png) 89 | - (2025.02.12) enable HUD ![](documentation/HUD.png)
mapsize not yet scaleable 90 | - (2025.02.18) enable "invisible" drawing ![](documentation/invisible.png) 91 | - (2025.02.28) reached finish screen ![](documentation/finish_screen.png) -------------------------------------------------------------------------------- /differences.md: -------------------------------------------------------------------------------- 1 | # Differences to known DOOM versions (Vanilla / Chocolate / Crispy) 2 | 3 | ### Viewport zooming 4 | 5 | In Vanilla Doom it is possible to "zoom" the viewport to be very small and instead render a background pattern. This feature made sense in the old day's, but today not. Via "+" and "-" the player can deside between 3 viewport sizes: 6 | 7 | - Fullscreen, no HUD 8 | - Normal HUD 9 | - Reduced HUD 10 | 11 | ### Silent fist option 12 | 13 | In DOOM every weapon makes noises and therefore wakes up all the enemies. In FPC_DOOM you could set the "fistisquit" flag. If set, "shooting" by punching with the fist does not make any noise. But if you do not kill a opponent in one shot, this opponent will scream and that will be heared. This feature makes most sense when playing in bersek mode. 14 | 15 | ### Savegames 16 | 17 | ATM there are no savegames available, but even if the will be not compatible to any other DOOM version! This is due to the fact that it seems that DOOM tries to store pointers in the savegames, and as FPC DOOM is running on 64-Bit it will never be compatible to 32-Bit pointer storages. 18 | 19 | ## Key settings 20 | 21 | The following keys are used (given on a german keyboard layout): 22 | 23 | Automap: 24 | | Key | description | 25 | | --- | --- | 26 | | +/- | Zoom in / out map 27 | | o | Toggle map overlay 28 | | r | Togle map rotate 29 | | CURSOR's | move map 30 | | TAB | close Automap 31 | | m | place mark on map 32 | | c | clear all marks 33 | | PAUSE | toggle Pause the game 34 | 35 | Playing: 36 | | Key | description | 37 | | --- | --- | 38 | | +/- | Zoom in / out viewport 39 | | ESC | Open main menu 40 | | CURSOR's | move player 41 | | a/d | Strafe left, right 42 | | CTRL | Trigger weapon 43 | | 1 .. 6 | Select weapon if available (1,2 switch between fist/saw, shotgun/ double shotgun) 44 | | TAB | open Automap 45 | | SHIFT | when pressed activate "run" mode 46 | | PAUSE | toggle Pause the game 47 | | w | when activated by settings, jump 48 | | SPACE | use "thing" if directly in front of player 49 | 50 | Menu: 51 | | Key | description | 52 | | --- | --- | 53 | | RETURN | confirm 54 | | BACK | go to previos menu 55 | | Y | confirm 56 | | N | abort 57 | 58 | ## Cheats 59 | 60 | Not all but a lot of cheats are available, here is the list: 61 | 62 | - iddt 63 | - iddqd 64 | - idkfa 65 | - idfa 66 | - idclip / idspispopd 67 | - tntweap* 68 | - idclev** 69 | 70 | 71 | -------------------------------------------------------------------------------- /documentation/DOOM_Sound.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/DOOM_Sound.mp4 -------------------------------------------------------------------------------- /documentation/HUD.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/HUD.png -------------------------------------------------------------------------------- /documentation/Hanger_Finished.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/Hanger_Finished.gif -------------------------------------------------------------------------------- /documentation/Menu_first.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/Menu_first.gif -------------------------------------------------------------------------------- /documentation/Menu_til_start.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/Menu_til_start.gif -------------------------------------------------------------------------------- /documentation/WAD_Viewer_001.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/WAD_Viewer_001.png -------------------------------------------------------------------------------- /documentation/am_map_finished.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/am_map_finished.gif -------------------------------------------------------------------------------- /documentation/am_map_normal.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/am_map_normal.gif -------------------------------------------------------------------------------- /documentation/doom.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/doom.png -------------------------------------------------------------------------------- /documentation/e1m1_100.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/e1m1_100.png -------------------------------------------------------------------------------- /documentation/e1m2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/e1m2.png -------------------------------------------------------------------------------- /documentation/finish_screen.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/finish_screen.png -------------------------------------------------------------------------------- /documentation/first_app_rendering.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/first_app_rendering.png -------------------------------------------------------------------------------- /documentation/invisible.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/invisible.png -------------------------------------------------------------------------------- /documentation/open_door.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/open_door.gif -------------------------------------------------------------------------------- /documentation/raise_pistol.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/raise_pistol.gif -------------------------------------------------------------------------------- /documentation/rotate.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/rotate.gif -------------------------------------------------------------------------------- /documentation/shoot_barrel.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/shoot_barrel.gif -------------------------------------------------------------------------------- /documentation/sprites.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/sprites.png -------------------------------------------------------------------------------- /documentation/very_first_screenrender.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/very_first_screenrender.png -------------------------------------------------------------------------------- /documentation/walking.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/walking.gif -------------------------------------------------------------------------------- /documentation/wipe.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/wipe.gif -------------------------------------------------------------------------------- /documentation/with_flats.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/FPC_DOOM/f25f51cabf377fe7461e58a8f9c5ace2e721cafd/documentation/with_flats.png -------------------------------------------------------------------------------- /doom_vs_lcl.md: -------------------------------------------------------------------------------- 1 | # DOOM vs LCL (Lazarus Component Library) 2 | In this section i want to handle all topics which are not directly C / C++ dependant, but more architectural. 3 | 4 | ## Polling vs. event based programming 5 | 6 | Orig DOOM was written for DOS, in DOS the application more or less "owns" the machine when running. This means that the application need to implement a while loop which polls all the "devices" and then decides which code to be executed. 7 | 8 | The corresponding C code for DOOM is located in d_main.c and i_main.c. Below is the simplified version of how this is done in DOOM. 9 | 10 | ### i_main.c : 11 | ```C++ 12 | int main(int argc, char **argv) 13 | { 14 | // init SDL 15 | .. 16 | // start DOOM 17 | D_DoomMain(); // never returns 18 | } 19 | ``` 20 | 21 | ### d_main.c : 22 | ```C++ 23 | // 24 | // D_DoomMain 25 | // 26 | void D_DoomMain (void) 27 | { 28 | // Read in most of the console params 29 | .. 30 | // Run the main loop, there are multiple "entrances" to D_DoomLoop depending 31 | // on the game mode. But at the end it does not matter which mode, all end up 32 | // calling D_DoomLoop. 33 | D_DoomLoop(); // never returns 34 | } 35 | 36 | // 37 | // D_DoomLoop 38 | // 39 | void D_DoomLoop (void) 40 | { 41 | // Init more stuff relevant for drawing a window 42 | .. 43 | // Reset the game internal time measuring system 44 | // This is important when playing replay's as DOOM is "deterministic" 45 | // when simulating. 46 | D_StartGameLoop(); 47 | 48 | // Polling forever 49 | while (1) 50 | { 51 | D_RunFrame(); 52 | } 53 | } 54 | 55 | // 56 | // D_RunFrame 57 | // 58 | void D_RunFrame() 59 | { 60 | static boolean wipe = false; // Controlls the wipe function 61 | if (wipe) 62 | { 63 | // Draw the wipe animation, by complete blocking everything! 64 | // The wipe function starts with the last rendered framebufer and 65 | // wipes this into the wipe endscreen buffer. When finished, the 66 | // wipe variable is set to 0 and application execution continues like 67 | // nothing has happened. 68 | wipe = !wipe_ScreenWipe(..); 69 | M_Drawer(); // menu is drawn even on top of wipes 70 | I_FinishUpdate(); // copy framebuffer to screen 71 | return; 72 | } 73 | 74 | // Start rendering a new frame, aktually the function call does nothing 75 | // as the framebuffer is completly writen by D_Display function. 76 | I_StartFrame (); 77 | 78 | // Simulate at least 1 tic (= 35ms) 79 | // Here the complete "Game logic" is executed and handled (but not rendered). 80 | TryRunTics (); 81 | 82 | // Renders everything to the framebuffer and decides if a wipe animation needs 83 | // to be started. 84 | wipe = D_Display(); 85 | if (wipe) 86 | { 87 | // init the wipe endscreen by reading the framebuffer. 88 | // Store the actual gametic, so that wipe can be calculated correct. 89 | // ! Attention ! 90 | // there is no rendering to the screen, so the application is still "showing" the last 91 | // framebuffer before wipe starts. 92 | } else { 93 | I_FinishUpdate (); // copy framebuffer to screen 94 | } 95 | } 96 | ``` 97 | On modern frameworks (like used by LCL) this while loop is hidden deep inside the framework. Writing a while loop that runs forever is not allowed in this situation and can cause strange and unwanted behavior. The function calls shown above had to be converted for this reason into the schema shown below. 98 | ```pascal 99 | 100 | Procedure TForm1.OpenGLControl1MakeCurrent(Sender: TObject; Var Allow: boolean); 101 | Begin 102 | // init OpenGL 103 | .. 104 | // start DOOM 105 | D_DoomMain(); 106 | End; 107 | 108 | // 109 | // D_DoomMain 110 | // 111 | Procedure D_DoomMain(); 112 | Begin 113 | // Read in most of the console params 114 | .. 115 | // Run the main loop, there are multiple "entrances" to D_DoomLoop depending 116 | // on the game mode. But at the end it does not matter which mode, all end up 117 | // calling D_DoomLoop. 118 | // D_DoomLoop(); 119 | (* -- This is the part from D_DoomLoop without the while(1) *) 120 | // Init more stuff relevant for drawing a window 121 | .. 122 | // Reset the game internal time measuring system 123 | // This is important when playing replay's as DOOM is "deterministic" 124 | // when simulating. 125 | D_StartGameLoop(); 126 | End; 127 | 128 | // 129 | // Render Event generating Timer (each 17ms) 130 | // 131 | Procedure TForm1.Timer1Timer(Sender: TObject); 132 | Begin 133 | If Initialized Then Begin 134 | OpenGLControl1.Invalidate; // -> This triggers the OpenGLControl1Paint method 135 | End; 136 | End; 137 | 138 | Procedure TForm1.OpenGLControl1Paint(Sender: TObject); 139 | Begin 140 | If Not Initialized Then Exit; 141 | // Render Szene 142 | glClearColor(0.0, 0.0, 0.0, 0.0); 143 | glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT); 144 | glLoadIdentity(); 145 | go2d; 146 | (* 147 | * D_DoomLoop now tells whether the buffers are valid to swap (normal) 148 | * or in case of starting a wipe (or if is called to frequently) nothing should happen 149 | *) 150 | SkipSwapBuffers := D_DoomLoop(); 151 | exit2d; 152 | If Not SkipSwapBuffers Then Begin 153 | OpenGLControl1.SwapBuffers; 154 | End; 155 | End; 156 | 157 | Function D_DoomLoop(): Boolean; 158 | Begin 159 | result := D_RunFrame(); 160 | End; 161 | 162 | // 163 | // D_RunFrame 164 | // 165 | 166 | Function D_RunFrame(): Boolean; 167 | Const 168 | wipe: boolean = false; 169 | oldgametic: int = 0; 170 | Var 171 | nowtime: int; 172 | tics: int; 173 | Begin 174 | result := false; 175 | tics := I_GetTime(); 176 | // Logic that detects, that no game tic passed since last call -> return doing nothing 177 | If tics = oldgametic Then Begin 178 | result := true; 179 | exit; 180 | End; 181 | oldgametic := tics; 182 | If (wipe) Then Begin 183 | // Draw the wipe animation, by complete blocking everything! 184 | // The wipe function starts with the last rendered framebufer and 185 | // wipes this into the wipe endscreen buffer. When finished, the 186 | // wipe variable is set to 0 and application execution continues like 187 | // nothing has happened. 188 | wipe := not wipe_ScreenWipe(..); 189 | M_Drawer(); // menu is drawn even on top of wipes 190 | I_FinishUpdate(); // copy framebuffer to screen 191 | Exit; 192 | End; 193 | 194 | // Start rendering a new frame, aktually the function call does nothing 195 | // as the framebuffer is completly writen by D_Display function. 196 | I_StartFrame (); 197 | 198 | // Simulate at least 1 tic (= 35ms) 199 | // Here the complete "Game logic" is executed and handled (but not rendered). 200 | TryRunTics (); 201 | 202 | // Renders everything to the framebuffer and decides if a wipe animation needs 203 | // to be started. 204 | wipe := D_Display(); 205 | If (wipe) Then Begin 206 | // init the wipe endscreen by reading the framebuffer. 207 | // Store the actual gametic, so that wipe can be calculated correct. 208 | // ! Attention ! 209 | // there is no rendering to the screen, so the application is still "showing" the last 210 | // framebuffer before wipe starts. 211 | End Else Begin 212 | I_FinishUpdate (); // copy framebuffer to screen 213 | End; 214 | End; 215 | 216 | ``` 217 | 218 | ## The keyboard driver 219 | 220 | Orig DOOM uses scancodes directly from the keyboard and converts them into "local" keys (e.g. "z" and "y" are swapped on german and english keyboards). When controlling game mechanics like "zoom in" the orig scancodes are used. When entering e.g. texts for chats or savegame names, the translated version is used. 221 | 222 | FPC_DOOM uses the LCL keys, atm there is no localisation implemented. -------------------------------------------------------------------------------- /license.md: -------------------------------------------------------------------------------- 1 | There are two licenses for this software you can choose of: 2 | # 1. Postcardware 3 | you can download COPYING.Postcardware using this link:
4 | https://github.com/PascalCorpsman/Software_Licenses/blob/main/COPYING.Postcardware.txt 5 | 6 | or 7 | # 2. modified LGPL (as described in COPYING.modifiedLGPL) 8 | you can download COPYING.modifiedLGPL using this link:
9 | https://github.com/PascalCorpsman/Software_Licenses/blob/main/COPYING.modifiedLGPL.txt 10 | 11 | 12 | -------------------------------------------------------------------------------- /src/WAD_Viewer/project1.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | <Scaled Value="True"/> 10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <XPManifest> 13 | <DpiAware Value="True"/> 14 | </XPManifest> 15 | </General> 16 | <BuildModes> 17 | <Item Name="Default" Default="True"/> 18 | </BuildModes> 19 | <PublishOptions> 20 | <Version Value="2"/> 21 | <UseFileFilters Value="True"/> 22 | </PublishOptions> 23 | <RunParams> 24 | <FormatVersion Value="2"/> 25 | </RunParams> 26 | <RequiredPackages> 27 | <Item> 28 | <PackageName Value="LCL"/> 29 | </Item> 30 | </RequiredPackages> 31 | <Units> 32 | <Unit> 33 | <Filename Value="project1.lpr"/> 34 | <IsPartOfProject Value="True"/> 35 | </Unit> 36 | <Unit> 37 | <Filename Value="unit1.pas"/> 38 | <IsPartOfProject Value="True"/> 39 | <ComponentName Value="Form1"/> 40 | <HasResources Value="True"/> 41 | <ResourceBaseClass Value="Form"/> 42 | <UnitName Value="Unit1"/> 43 | </Unit> 44 | <Unit> 45 | <Filename Value="..\units\w_wad.pas"/> 46 | <IsPartOfProject Value="True"/> 47 | </Unit> 48 | <Unit> 49 | <Filename Value="..\ufpc_doom_types.pas"/> 50 | <IsPartOfProject Value="True"/> 51 | </Unit> 52 | <Unit> 53 | <Filename Value="..\units\i_system.pas"/> 54 | <IsPartOfProject Value="True"/> 55 | </Unit> 56 | <Unit> 57 | <Filename Value="..\units\config.pas"/> 58 | <IsPartOfProject Value="True"/> 59 | </Unit> 60 | <Unit> 61 | <Filename Value="unit2.pas"/> 62 | <IsPartOfProject Value="True"/> 63 | <ComponentName Value="Form2"/> 64 | <HasResources Value="True"/> 65 | <ResourceBaseClass Value="Form"/> 66 | <UnitName Value="Unit2"/> 67 | </Unit> 68 | <Unit> 69 | <Filename Value="..\units\v_patch.pas"/> 70 | <IsPartOfProject Value="True"/> 71 | </Unit> 72 | <Unit> 73 | <Filename Value="unit3.pas"/> 74 | <IsPartOfProject Value="True"/> 75 | <ComponentName Value="Form3"/> 76 | <HasResources Value="True"/> 77 | <ResourceBaseClass Value="Form"/> 78 | <UnitName Value="Unit3"/> 79 | </Unit> 80 | <Unit> 81 | <Filename Value="uwad_viewer.pas"/> 82 | <IsPartOfProject Value="True"/> 83 | <UnitName Value="uWAD_viewer"/> 84 | </Unit> 85 | <Unit> 86 | <Filename Value="unit4.pas"/> 87 | <IsPartOfProject Value="True"/> 88 | <ComponentName Value="Form4"/> 89 | <HasResources Value="True"/> 90 | <ResourceBaseClass Value="Form"/> 91 | <UnitName Value="Unit4"/> 92 | </Unit> 93 | <Unit> 94 | <Filename Value="..\..\Sample\Sound\uwave.pas"/> 95 | <IsPartOfProject Value="True"/> 96 | </Unit> 97 | <Unit> 98 | <Filename Value="..\..\Sample\Sound\Bass\bass.pas"/> 99 | <IsPartOfProject Value="True"/> 100 | <UnitName Value="BASS"/> 101 | </Unit> 102 | <Unit> 103 | <Filename Value="..\units\s_sound.pas"/> 104 | <IsPartOfProject Value="True"/> 105 | </Unit> 106 | <Unit> 107 | <Filename Value="unit5.pas"/> 108 | <IsPartOfProject Value="True"/> 109 | <ComponentName Value="Form5"/> 110 | <HasResources Value="True"/> 111 | <ResourceBaseClass Value="Form"/> 112 | <UnitName Value="Unit5"/> 113 | </Unit> 114 | <Unit> 115 | <Filename Value="unit6.pas"/> 116 | <IsPartOfProject Value="True"/> 117 | <ComponentName Value="Form6"/> 118 | <ResourceBaseClass Value="Form"/> 119 | <UnitName Value="Unit6"/> 120 | </Unit> 121 | <Unit> 122 | <Filename Value="..\..\Sample\DatenSteuerung\ufifo.pas"/> 123 | <IsPartOfProject Value="True"/> 124 | </Unit> 125 | <Unit> 126 | <Filename Value="..\..\Sample\OpenGL\dglopengl.pas"/> 127 | <IsPartOfProject Value="True"/> 128 | <UnitName Value="dglOpenGL"/> 129 | </Unit> 130 | </Units> 131 | </ProjectOptions> 132 | <CompilerOptions> 133 | <Version Value="11"/> 134 | <PathDelim Value="\"/> 135 | <Target> 136 | <Filename Value="..\WAD_viewer"/> 137 | </Target> 138 | <SearchPaths> 139 | <IncludeFiles Value="$(ProjOutDir)"/> 140 | <OtherUnitFiles Value="..\units;..;..\..\Sample\Sound;..\..\Sample\Sound\Bass;..\..\Sample\DatenSteuerung;..\..\Sample\OpenGL"/> 141 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 142 | </SearchPaths> 143 | <Parsing> 144 | <SyntaxOptions> 145 | <IncludeAssertionCode Value="True"/> 146 | </SyntaxOptions> 147 | </Parsing> 148 | <CodeGeneration> 149 | <Checks> 150 | <IOChecks Value="True"/> 151 | <RangeChecks Value="True"/> 152 | <OverflowChecks Value="True"/> 153 | <StackChecks Value="True"/> 154 | </Checks> 155 | <VerifyObjMethodCallValidity Value="True"/> 156 | </CodeGeneration> 157 | <Linking> 158 | <Debugging> 159 | <UseHeaptrc Value="True"/> 160 | </Debugging> 161 | </Linking> 162 | </CompilerOptions> 163 | <Debugging> 164 | <Exceptions> 165 | <Item> 166 | <Name Value="EAbort"/> 167 | </Item> 168 | <Item> 169 | <Name Value="ECodetoolError"/> 170 | </Item> 171 | <Item> 172 | <Name Value="EFOpenError"/> 173 | </Item> 174 | </Exceptions> 175 | </Debugging> 176 | </CONFIG> 177 | -------------------------------------------------------------------------------- /src/WAD_Viewer/project1.lpr: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of WAD_Viewer *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Program project1; 16 | 17 | {$MODE objfpc}{$H+} 18 | 19 | Uses 20 | {$IFDEF UNIX} 21 | cthreads, 22 | {$ENDIF} 23 | {$IFDEF HASAMIGA} 24 | athreads, 25 | {$ENDIF} 26 | Interfaces, // this includes the LCL widgetset 27 | Forms, unit1, unit2, unit3, unit4, unit5, unit6; 28 | 29 | {$R *.res} 30 | 31 | Begin 32 | RequireDerivedFormResource := True; 33 | Application.Scaled:=True; 34 | Application.Initialize; 35 | Application.CreateForm(TForm1, Form1); 36 | Application.CreateForm(TForm2, Form2); 37 | Application.CreateForm(TForm3, Form3); 38 | Application.CreateForm(TForm4, Form4); 39 | Application.CreateForm(TForm5, Form5); 40 | Application.CreateForm(TForm6, Form6); 41 | Application.Run; 42 | End. 43 | 44 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 1359 3 | Height = 505 4 | Top = 431 5 | Width = 362 6 | Caption = 'Form1' 7 | ClientHeight = 505 8 | ClientWidth = 362 9 | Position = poScreenCenter 10 | LCLVersion = '4.99.0.0' 11 | OnCreate = FormCreate 12 | OnDestroy = FormDestroy 13 | object Button1: TButton 14 | Left = 8 15 | Height = 25 16 | Top = 8 17 | Width = 346 18 | Anchors = [akTop, akLeft, akRight] 19 | Caption = 'Select .wad file' 20 | TabOrder = 0 21 | OnClick = Button1Click 22 | end 23 | object StringGrid1: TStringGrid 24 | Left = 8 25 | Height = 368 26 | Top = 72 27 | Width = 346 28 | Anchors = [akTop, akLeft, akRight, akBottom] 29 | Columns = < 30 | item 31 | Title.Caption = 'Index' 32 | end 33 | item 34 | Title.Caption = 'Name' 35 | end 36 | item 37 | Title.Caption = 'Size' 38 | end 39 | item 40 | Title.Caption = 'Type' 41 | end 42 | item 43 | ButtonStyle = cbsButtonColumn 44 | Title.Caption = 'Action' 45 | end> 46 | FixedCols = 0 47 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect, goSmoothScroll] 48 | TabOrder = 1 49 | OnDblClick = StringGrid1DblClick 50 | OnButtonClick = StringGrid1ButtonClick 51 | end 52 | object Edit1: TEdit 53 | Left = 72 54 | Height = 26 55 | Top = 38 56 | Width = 64 57 | TabOrder = 2 58 | Text = 'Edit1' 59 | OnChange = Edit1Change 60 | end 61 | object Label1: TLabel 62 | Left = 8 63 | Height = 16 64 | Top = 48 65 | Width = 31 66 | Caption = 'Filter' 67 | end 68 | object Button2: TButton 69 | Left = 8 70 | Height = 25 71 | Top = 471 72 | Width = 346 73 | Anchors = [akLeft, akRight, akBottom] 74 | Caption = 'Close' 75 | TabOrder = 3 76 | OnClick = Button2Click 77 | end 78 | object Button3: TButton 79 | Left = 192 80 | Height = 25 81 | Top = 216 82 | Width = 75 83 | Caption = 'Save' 84 | TabOrder = 4 85 | Visible = False 86 | OnClick = Button3Click 87 | end 88 | object Button4: TButton 89 | Left = 192 90 | Height = 25 91 | Top = 184 92 | Width = 75 93 | Caption = 'Load' 94 | TabOrder = 5 95 | Visible = False 96 | OnClick = Button4Click 97 | end 98 | object Edit2: TEdit 99 | Left = 200 100 | Height = 26 101 | Top = 38 102 | Width = 64 103 | TabOrder = 6 104 | Text = 'Edit2' 105 | OnChange = Edit2Change 106 | end 107 | object Label2: TLabel 108 | Left = 8 109 | Height = 16 110 | Top = 447 111 | Width = 41 112 | Anchors = [akLeft, akBottom] 113 | Caption = 'Label2' 114 | end 115 | object Edit3: TEdit 116 | Left = 136 117 | Height = 26 118 | Hint = 'Prefix with <, =, > to refine searchings'#10'> is default' 119 | Top = 38 120 | Width = 64 121 | ParentShowHint = False 122 | ShowHint = True 123 | TabOrder = 7 124 | Text = 'Edit3' 125 | OnChange = Edit3Change 126 | end 127 | object OpenDialog1: TOpenDialog 128 | DefaultExt = '.wad' 129 | Filter = 'Wad file|*.wad|All files|*.*' 130 | Left = 80 131 | Top = 184 132 | end 133 | end 134 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit2.lfm: -------------------------------------------------------------------------------- 1 | object Form2: TForm2 2 | Left = 353 3 | Height = 240 4 | Top = 124 5 | Width = 318 6 | Caption = 'Form2' 7 | ClientHeight = 240 8 | ClientWidth = 318 9 | Position = poScreenCenter 10 | LCLVersion = '3.99.0.0' 11 | OnCreate = FormCreate 12 | object Label1: TLabel 13 | Left = 8 14 | Height = 15 15 | Top = 10 16 | Width = 64 17 | Caption = 'Lump name' 18 | end 19 | object Label2: TLabel 20 | Left = 87 21 | Height = 15 22 | Top = 10 23 | Width = 34 24 | Caption = 'Label2' 25 | end 26 | object RadioGroup1: TRadioGroup 27 | Left = 8 28 | Height = 160 29 | Top = 32 30 | Width = 296 31 | AutoFill = True 32 | Caption = ' select datatype ' 33 | ChildSizing.LeftRightSpacing = 6 34 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 35 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 36 | ChildSizing.ShrinkHorizontal = crsScaleChilds 37 | ChildSizing.ShrinkVertical = crsScaleChilds 38 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 39 | ChildSizing.ControlsPerLine = 1 40 | TabOrder = 0 41 | end 42 | object Button1: TButton 43 | Left = 8 44 | Height = 25 45 | Top = 200 46 | Width = 296 47 | Caption = 'Do' 48 | TabOrder = 1 49 | OnClick = Button1Click 50 | end 51 | object SaveDialog1: TSaveDialog 52 | Left = 176 53 | Top = 32 54 | end 55 | end 56 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit2.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of WAD_Viewer *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit2; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls; 23 | 24 | Type 25 | 26 | { TForm2 } 27 | 28 | TForm2 = Class(TForm) 29 | Button1: TButton; 30 | Label1: TLabel; 31 | Label2: TLabel; 32 | RadioGroup1: TRadioGroup; 33 | SaveDialog1: TSaveDialog; 34 | Procedure Button1Click(Sender: TObject); 35 | Procedure FormCreate(Sender: TObject); 36 | private 37 | Procedure LoadAndShowPatch(Const Lump: String); 38 | Procedure LoadAndShowFlat(Const Lump: String); 39 | Procedure LoadAndShowSound(Const Lump: String); 40 | Procedure LoadAndShowMusic(Const Lump: String); 41 | Procedure LoadAndShowMap(Const Lump: String); 42 | Procedure ExportAsRaw(Const Lump: String); 43 | public 44 | Procedure SelectDatatypeByString(Const Datatype: String); 45 | End; 46 | 47 | Var 48 | Form2: TForm2; 49 | 50 | Implementation 51 | 52 | {$R *.lfm} 53 | 54 | Uses Unit3, Unit4, Unit5, Unit6, uWAD_viewer, w_wad; 55 | 56 | { TForm2 } 57 | 58 | Procedure TForm2.Button1Click(Sender: TObject); 59 | Var 60 | s: String; 61 | Begin 62 | If RadioGroup1.ItemIndex < 0 Then exit; 63 | s := RadioGroup1.Items[RadioGroup1.ItemIndex]; 64 | If s = LumpTypeToString(ltPatch) Then Begin 65 | LoadAndShowPatch(label2.caption); 66 | End; 67 | If s = LumpTypeToString(ltSound) Then Begin 68 | LoadAndShowSound(label2.caption); 69 | End; 70 | If s = LumpTypeToString(ltMusic) Then Begin 71 | LoadAndShowMusic(label2.caption); 72 | End; 73 | If s = LumpTypeToString(ltMap) Then Begin 74 | LoadAndShowMap(label2.caption); 75 | End; 76 | If s = LumpTypeToString(ltExportAsRaw) Then Begin 77 | ExportAsRaw(label2.caption); 78 | End; 79 | If s = LumpTypeToString(ltFlat) Then Begin 80 | LoadAndShowFlat(label2.caption); 81 | End; 82 | End; 83 | 84 | Procedure TForm2.FormCreate(Sender: TObject); 85 | Var 86 | i: Integer; 87 | Begin 88 | caption := 'Select action'; 89 | RadioGroup1.items.Clear; 90 | For i := 1 To integer(ltCount) - 1 Do Begin // ltUnknown wird ausgelassen 91 | RadioGroup1.items.Add( 92 | LumpTypeToString( 93 | TLumpType(i)) 94 | ); 95 | End; 96 | End; 97 | 98 | Procedure TForm2.LoadAndShowPatch(Const Lump: String); 99 | Begin 100 | If form3.LoadPatchLump(Lump) Then Begin 101 | form3.ShowModal; 102 | End 103 | Else Begin 104 | showmessage('Error, "' + lump + '" does not seem to be a valild patch_t'); 105 | End; 106 | End; 107 | 108 | Procedure TForm2.LoadAndShowFlat(Const Lump: String); 109 | Begin 110 | If form3.LoadFlatLump(Lump) Then Begin 111 | form3.ShowModal; 112 | End 113 | Else Begin 114 | showmessage('Error, "' + lump + '" does not seem to be a valild flat'); 115 | End; 116 | End; 117 | 118 | Procedure TForm2.LoadAndShowSound(Const Lump: String); 119 | Begin 120 | If form4.LoadSoundLump(Lump) Then Begin 121 | form4.ShowModal; 122 | End 123 | Else Begin 124 | showmessage('Error, "' + lump + '" does not seem to be a valild sound'); 125 | End; 126 | End; 127 | 128 | Procedure TForm2.LoadAndShowMusic(Const Lump: String); 129 | Begin 130 | If form5.LoadSoundLump(Lump) Then Begin 131 | form5.ShowModal; 132 | End 133 | Else Begin 134 | showmessage('Error, "' + lump + '" does not seem to be a valild music'); 135 | End; 136 | End; 137 | 138 | Procedure TForm2.LoadAndShowMap(Const Lump: String); 139 | Begin 140 | If form6.LoadMapLump(Lump) Then Begin 141 | form6.ShowModal; 142 | End 143 | Else Begin 144 | showmessage('Error, "' + lump + '" does not seem to be a valild map'); 145 | End; 146 | End; 147 | 148 | Procedure TForm2.ExportAsRaw(Const Lump: String); 149 | Var 150 | m: TMemoryStream; 151 | p: PByte; 152 | Begin 153 | SaveDialog1.Filename := Lump + '.lump'; 154 | If SaveDialog1.Execute Then Begin 155 | m := TMemoryStream.Create; 156 | p := W_CacheLumpName(lump, 0); 157 | m.Write(p^, W_LumpLength(W_GetNumForName(lump))); 158 | m.SaveToFile(SaveDialog1.FileName); 159 | m.free; 160 | End; 161 | End; 162 | 163 | Procedure TForm2.SelectDatatypeByString(Const Datatype: String); 164 | Var 165 | i: Integer; 166 | Begin 167 | RadioGroup1.ItemIndex := -1; 168 | For i := 0 To RadioGroup1.Items.Count - 1 Do Begin 169 | If Datatype = RadioGroup1.Items[i] Then Begin 170 | RadioGroup1.ItemIndex := i; 171 | exit; 172 | End; 173 | End; 174 | End; 175 | 176 | End. 177 | 178 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit3.lfm: -------------------------------------------------------------------------------- 1 | object Form3: TForm3 2 | Left = 332 3 | Height = 495 4 | Top = 112 5 | Width = 667 6 | Caption = 'Form3' 7 | ClientHeight = 495 8 | ClientWidth = 667 9 | Position = poScreenCenter 10 | LCLVersion = '3.99.0.0' 11 | OnCreate = FormCreate 12 | OnDestroy = FormDestroy 13 | object Image1: TImage 14 | Left = 8 15 | Height = 400 16 | Top = 80 17 | Width = 640 18 | PopupMenu = PopupMenu1 19 | Proportional = True 20 | Stretch = True 21 | end 22 | object Label1: TLabel 23 | Left = 8 24 | Height = 15 25 | Top = 32 26 | Width = 60 27 | Caption = 'Dimension:' 28 | end 29 | object Label2: TLabel 30 | Left = 80 31 | Height = 15 32 | Top = 32 33 | Width = 34 34 | Caption = 'Label2' 35 | end 36 | object Label3: TLabel 37 | Left = 8 38 | Height = 15 39 | Top = 9 40 | Width = 35 41 | Caption = 'Name:' 42 | end 43 | object Label4: TLabel 44 | Left = 80 45 | Height = 15 46 | Top = 9 47 | Width = 34 48 | Caption = 'Label4' 49 | end 50 | object Button1: TButton 51 | Left = 416 52 | Height = 25 53 | Top = 9 54 | Width = 232 55 | Caption = 'Convert .bmp to lump with same name' 56 | TabOrder = 0 57 | OnClick = Button1Click 58 | end 59 | object Label5: TLabel 60 | Left = 8 61 | Height = 15 62 | Top = 53 63 | Width = 32 64 | Caption = 'Offset' 65 | end 66 | object Label6: TLabel 67 | Left = 80 68 | Height = 15 69 | Top = 53 70 | Width = 34 71 | Caption = 'Label6' 72 | end 73 | object PopupMenu1: TPopupMenu 74 | Left = 148 75 | Top = 151 76 | object MenuItem1: TMenuItem 77 | Caption = 'Export' 78 | OnClick = MenuItem1Click 79 | end 80 | end 81 | object SaveDialog1: TSaveDialog 82 | DefaultExt = '.bmp' 83 | Filter = 'Windows Bitmap|*.bmp|All|*.*' 84 | Left = 264 85 | Top = 151 86 | end 87 | object OpenDialog1: TOpenDialog 88 | DefaultExt = '.bmp' 89 | Filter = 'Windows Bitmap|*.bmp|All|*.*' 90 | Left = 472 91 | Top = 48 92 | end 93 | end 94 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit4.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of WAD_Viewer *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit4; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, 23 | Buttons, uwave 24 | ; 25 | 26 | Const 27 | PadLen = 32; 28 | 29 | Type 30 | // Quelle: https://doomwiki.org/wiki/Sound 31 | TDMXSound = Packed Record 32 | Format: UInt16; 33 | SampleRate: UInt16; 34 | NumberOfSamples: UInt32; 35 | PADDING1: Array[0..15] Of ShortInt; // Die ersten 16 und letzten 16 Byte werden nicht genutzt. 36 | SOUND: Array[0..high(Integer)] Of ShortInt; // Der ist also Gültig im Bereich [0..NumberOfSamples - PadLen - 1] 37 | // Padding2: Array [0..15] of ShortInt; 38 | End; 39 | 40 | { TForm4 } 41 | 42 | TForm4 = Class(TForm) 43 | Button1: TButton; 44 | CheckBox1: TCheckBox; 45 | Label1: TLabel; 46 | Label2: TLabel; 47 | Label3: TLabel; 48 | Label4: TLabel; 49 | Label5: TLabel; 50 | Label6: TLabel; 51 | SaveDialog1: TSaveDialog; 52 | SpeedButton1: TSpeedButton; 53 | Procedure Button1Click(Sender: TObject); 54 | Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean); 55 | Procedure FormCreate(Sender: TObject); 56 | Procedure FormDestroy(Sender: TObject); 57 | Procedure SpeedButton1Click(Sender: TObject); 58 | private 59 | wav: TWave; 60 | LumpName: String; 61 | public 62 | Function LoadSoundLump(Const Lump: String): Boolean; 63 | End; 64 | 65 | Var 66 | Form4: TForm4; 67 | 68 | Implementation 69 | 70 | {$R *.lfm} 71 | 72 | Uses 73 | BASS 74 | , w_wad 75 | ; 76 | 77 | Var 78 | DMXSound: ^TDMXSound; 79 | DMXSoundIndex: integer; 80 | PreviewStream: HSTREAM; 81 | 82 | Function GetPreviewData(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; 83 | {$IFDEF Windows} stdcall; 84 | {$ELSE} cdecl; 85 | {$ENDIF} 86 | Var 87 | cnt: integer; 88 | buf: PByte; 89 | Begin 90 | buf := buffer; 91 | If (DMXSoundIndex + length) <= (DMXSound^.NumberOfSamples - PadLen) Then Begin 92 | cnt := length; 93 | End 94 | Else Begin 95 | cnt := (DMXSound^.NumberOfSamples - PadLen) - (DMXSoundIndex); 96 | End; 97 | move(DMXSound^.SOUND[DMXSoundIndex], buf^, cnt); 98 | DMXSoundIndex := DMXSoundIndex + cnt; 99 | result := cnt; 100 | If cnt <> length Then Begin 101 | If Form4.CheckBox1.Checked Then Begin // Loop Sounds 102 | DMXSoundIndex := 0; 103 | End 104 | Else Begin // End Sound 105 | result := result Or BASS_STREAMPROC_END; 106 | End; 107 | End; 108 | End; 109 | 110 | { TForm4 } 111 | 112 | Procedure TForm4.FormCreate(Sender: TObject); 113 | Begin 114 | 115 | // Einen Dummy erstellen, der wird nachher eh wieder weg geworfen.. 116 | PreviewStream := BASS_StreamCreate(44100, 1, BASS_SAMPLE_8BITS, @GetPreviewData, Nil); 117 | caption := 'Sound previewer'; 118 | Constraints.MinWidth := Width; 119 | Constraints.MinHeight := Height; 120 | Constraints.MaxWidth := Width; 121 | Constraints.MaxHeight := Height; 122 | wav := TWave.Create; 123 | End; 124 | 125 | Procedure TForm4.Button1Click(Sender: TObject); 126 | Begin 127 | SaveDialog1.FileName := LumpName + '.wav'; 128 | If SaveDialog1.Execute Then Begin 129 | wav.SaveToFile(SaveDialog1.FileName); 130 | End; 131 | End; 132 | 133 | Procedure TForm4.FormCloseQuery(Sender: TObject; Var CanClose: Boolean); 134 | Begin 135 | If BASS_ChannelIsActive(PreviewStream) <> 0 Then Begin 136 | BASS_ChannelStop(PreviewStream); 137 | End; 138 | End; 139 | 140 | Procedure TForm4.FormDestroy(Sender: TObject); 141 | Begin 142 | BASS_ChannelStop(PreviewStream); 143 | BASS_StreamFree(PreviewStream); 144 | wav.free; 145 | End; 146 | 147 | Procedure TForm4.SpeedButton1Click(Sender: TObject); 148 | Begin 149 | // Play 150 | If BASS_ChannelIsActive(PreviewStream) <> 0 Then Begin 151 | BASS_ChannelStop(PreviewStream); 152 | End; 153 | DMXSoundIndex := 0; 154 | If Not BASS_ChannelPlay(PreviewStream, true) Then Begin 155 | showmessage('Could not start stream playback'); 156 | End; 157 | End; 158 | 159 | Function TForm4.LoadSoundLump(Const Lump: String): Boolean; 160 | Var 161 | i: Integer; 162 | Begin 163 | LumpName := Lump; 164 | result := false; 165 | DMXSound := W_CacheLumpName(lump, 0); 166 | If DMXSound^.Format <> 3 Then exit; 167 | If (DMXSound^.SampleRate <> 11025) And (DMXSound^.SampleRate <> 22050) Then exit; 168 | If (DMXSound^.NumberOfSamples - PadLen) <= 0 Then exit; 169 | label2.caption := inttostr(DMXSound^.SampleRate); 170 | label4.caption := inttostr(DMXSound^.NumberOfSamples - PadLen); 171 | If DMXSound^.NumberOfSamples = 0 Then exit; 172 | label6.caption := format('%0.1fs', [(DMXSound^.NumberOfSamples - PadLen) / DMXSound^.SampleRate]); 173 | wav.InitNewBuffer(1, DMXSound^.SampleRate, 8, DMXSound^.NumberOfSamples - PadLen); 174 | For i := 0 To DMXSound^.NumberOfSamples - 1 - PadLen Do Begin 175 | wav.Sample[0, i] := (DMXSound^.SOUND[i] / 128); 176 | End; 177 | BASS_ChannelStop(PreviewStream); 178 | BASS_StreamFree(PreviewStream); 179 | PreviewStream := BASS_StreamCreate(DMXSound^.SampleRate, 1, BASS_SAMPLE_8BITS, @GetPreviewData, Nil); 180 | result := true; 181 | SpeedButton1Click(Nil); // Wir starten den Stream mal direct ;) 182 | End; 183 | 184 | End. 185 | 186 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit5.lfm: -------------------------------------------------------------------------------- 1 | object Form5: TForm5 2 | Left = 333 3 | Height = 218 4 | Top = 112 5 | Width = 291 6 | Caption = 'Form5' 7 | ClientHeight = 218 8 | ClientWidth = 291 9 | Position = poScreenCenter 10 | LCLVersion = '3.99.0.0' 11 | OnCreate = FormCreate 12 | object Label1: TLabel 13 | Left = 8 14 | Height = 15 15 | Top = 8 16 | Width = 48 17 | Caption = 'ScoreLen' 18 | end 19 | object Label2: TLabel 20 | Left = 8 21 | Height = 15 22 | Top = 32 23 | Width = 53 24 | Caption = 'ScoreStart' 25 | end 26 | object Label3: TLabel 27 | Left = 8 28 | Height = 15 29 | Top = 56 30 | Width = 49 31 | Caption = 'Channels' 32 | end 33 | object Label4: TLabel 34 | Left = 8 35 | Height = 15 36 | Top = 80 37 | Width = 70 38 | Caption = 'Sec Channels' 39 | end 40 | object Label5: TLabel 41 | Left = 8 42 | Height = 15 43 | Top = 104 44 | Width = 92 45 | Caption = 'Instrument count' 46 | end 47 | object Label6: TLabel 48 | Left = 120 49 | Height = 15 50 | Top = 8 51 | Width = 34 52 | Caption = 'Label6' 53 | end 54 | object Label7: TLabel 55 | Left = 120 56 | Height = 15 57 | Top = 32 58 | Width = 34 59 | Caption = 'Label7' 60 | end 61 | object Label8: TLabel 62 | Left = 120 63 | Height = 15 64 | Top = 56 65 | Width = 34 66 | Caption = 'Label8' 67 | end 68 | object Label9: TLabel 69 | Left = 120 70 | Height = 15 71 | Top = 80 72 | Width = 34 73 | Caption = 'Label9' 74 | end 75 | object Label10: TLabel 76 | Left = 120 77 | Height = 15 78 | Top = 104 79 | Width = 40 80 | Caption = 'Label10' 81 | end 82 | end 83 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit5.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of WAD_Viewer *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit5; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; 23 | 24 | Type 25 | 26 | { TForm5 } 27 | 28 | TForm5 = Class(TForm) 29 | Label1: TLabel; 30 | Label10: TLabel; 31 | Label2: TLabel; 32 | Label3: TLabel; 33 | Label4: TLabel; 34 | Label5: TLabel; 35 | Label6: TLabel; 36 | Label7: TLabel; 37 | Label8: TLabel; 38 | Label9: TLabel; 39 | Procedure FormCreate(Sender: TObject); 40 | private 41 | 42 | public 43 | Function LoadSoundLump(Const Lump: String): Boolean; 44 | End; 45 | 46 | Var 47 | Form5: TForm5; 48 | 49 | Implementation 50 | 51 | {$R *.lfm} 52 | 53 | Uses 54 | w_wad; 55 | 56 | Type 57 | MUSheader = Packed Record 58 | ID: Array[0..3] Of char; // identifier "MUS" 0x1A 59 | scoreLen: UInt16; 60 | scoreStart: UInt16; 61 | channels: UInt16; // count of primary channels 62 | sec_channels: UInt16; // count of secondary channels 63 | instrCnt: UInt16; 64 | dummy: UInt16; 65 | // variable-length part starts here 66 | instruments: Array[0..65536] Of UInt16; 67 | End; 68 | 69 | { TForm5 } 70 | 71 | Procedure TForm5.FormCreate(Sender: TObject); 72 | Begin 73 | caption := 'Music previewer'; 74 | End; 75 | 76 | Function TForm5.LoadSoundLump(Const Lump: String): Boolean; 77 | Var 78 | Header: ^MUSheader; 79 | Begin 80 | result := false; 81 | Header := W_CacheLumpName(lump, 0); 82 | If (header^.ID[0] <> 'M') Or 83 | (header^.ID[1] <> 'U') Or 84 | (header^.ID[2] <> 'S') Or 85 | (header^.ID[3] <> chr($1A)) Then exit; 86 | label6.Caption := inttostr(Header^.scoreLen); 87 | label7.Caption := inttostr(Header^.scoreStart); 88 | label8.Caption := inttostr(Header^.channels); 89 | label9.Caption := inttostr(Header^.sec_channels); 90 | label10.Caption := inttostr(Header^.instrCnt); 91 | result := true; 92 | End; 93 | 94 | End. 95 | 96 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit6.lfm: -------------------------------------------------------------------------------- 1 | object Form6: TForm6 2 | Left = 332 3 | Height = 515 4 | Top = 112 5 | Width = 632 6 | Caption = 'Form6' 7 | ClientHeight = 515 8 | ClientWidth = 632 9 | Position = poScreenCenter 10 | LCLVersion = '3.99.0.0' 11 | OnCreate = FormCreate 12 | object Image1: TImage 13 | Left = 0 14 | Height = 515 15 | Top = 0 16 | Width = 632 17 | Align = alClient 18 | Proportional = True 19 | Stretch = True 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /src/WAD_Viewer/unit6.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of WAD_Viewer *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit6; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls; 23 | 24 | Type 25 | 26 | { TForm6 } 27 | 28 | TForm6 = Class(TForm) 29 | Image1: TImage; 30 | Procedure FormCreate(Sender: TObject); 31 | private 32 | Procedure CreatepreviewImage(); 33 | public 34 | 35 | Function LoadMapLump(Const Lump: String): Boolean; 36 | 37 | End; 38 | 39 | Var 40 | Form6: TForm6; 41 | 42 | Implementation 43 | 44 | {$R *.lfm} 45 | 46 | Uses 47 | ufpc_doom_types, 48 | math 49 | , w_wad 50 | ; 51 | Type 52 | mapvertex_t = Packed Record 53 | x: Int16; 54 | y: Int16; 55 | End; 56 | 57 | maplinedef_t = Packed Record 58 | v1: uInt16; 59 | v2: uInt16; 60 | flags: uInt16; 61 | special: Int16; 62 | tag: Int16; 63 | sidenum: Array[0..1] Of uInt16; 64 | End; 65 | 66 | TMapLine = Record 67 | v1: uInt16; 68 | v2: uInt16; 69 | flags: uInt16; 70 | special: Int16; 71 | End; 72 | 73 | Var 74 | MapVertexes: Array Of TPoint; 75 | MapLines: Array Of TMapLine; 76 | MinDim, MaxDim: TPoint; 77 | MapWidth, MapHeight: Integer; 78 | 79 | { TForm6 } 80 | 81 | Procedure TForm6.FormCreate(Sender: TObject); 82 | Begin 83 | caption := 'Map previewer'; 84 | End; 85 | 86 | Procedure TForm6.CreatepreviewImage(); 87 | Var 88 | scale: Single; 89 | MDim, i: Integer; 90 | b: TBitmap; 91 | p1, p2: TPoint; 92 | Begin 93 | // So Scallieren, dass die Karte immer in eine maximal 1024x1024 Graphik Past 94 | mDim := max(MapWidth, MapHeight); 95 | scale := 1024 / mdim; 96 | b := TBitmap.Create; 97 | b.Width := round(MapWidth * scale); 98 | b.Height := round(MapHeight * scale); 99 | // Erst mal Alles Löschen 100 | b.canvas.Brush.Color := clBlack; 101 | b.Canvas.Rectangle(-1, -1, b.Width + 1, b.Height + 1); 102 | For i := 0 To high(MapLines) Do Begin 103 | p1 := point( 104 | round((MapVertexes[MapLines[i].v1].X - MinDim.x) * scale), 105 | round((MapVertexes[MapLines[i].v1].y - MinDim.y) * scale) 106 | ); 107 | p2 := point( 108 | round((MapVertexes[MapLines[i].v2].X - MinDim.x) * scale), 109 | round((MapVertexes[MapLines[i].v2].y - MinDim.y) * scale) 110 | ); 111 | // Irgendwie sieht es "Natürlicher" aus, wenn man die Karten auf dem Kopf malt.. 112 | p1.y := b.Height - p1.Y; 113 | p2.y := b.Height - p2.Y; 114 | // Zeichnen der Linien, es geht nicht alles, weil wir nicht alle Infos des Spieles haben, aber immerhin a bissl was ;) 115 | b.canvas.Pen.Color := $808080; // Normale Wände.. 116 | Case MapLines[i].special Of // Türen mit Schlüsselfarben 117 | 26, 32, 99, 133: b.canvas.Pen.Color := clBlue; 118 | 27, 34, 136, 137: b.canvas.Pen.Color := clYellow; 119 | 28, 33, 134, 135: b.canvas.Pen.Color := clRed; 120 | End; 121 | If MapLines[i].special In [11, 51, 52, 124] Then Begin // Exit Türen 122 | b.canvas.Pen.Color := clwhite; 123 | End; 124 | If MapLines[i].special In [39, 97] Then Begin // Teleporter 125 | b.canvas.Pen.Color := clFuchsia; 126 | End; 127 | b.canvas.Line(p1, p2); 128 | End; 129 | Image1.Picture.Assign(b); 130 | b.free; 131 | End; 132 | 133 | Function TForm6.LoadMapLump(Const Lump: String): Boolean; 134 | Var 135 | MapLumpIndex, VertexLumpIndex, LineDefsLumpIndex: integer; 136 | Vertexes: ^mapvertex_t; 137 | Lines: ^maplinedef_t; 138 | NumVertexes, NumLineDefs, i: Integer; 139 | Begin 140 | result := false; 141 | MapLumpIndex := W_CheckNumForName(Lump); 142 | If MapLumpIndex < 0 Then exit; 143 | VertexLumpIndex := MapLumpIndex + 4; 144 | If (VertexLumpIndex > high(lumpinfo)) Or (lumpinfo[VertexLumpIndex].name <> 'VERTEXES') Then exit; 145 | LineDefsLumpIndex := MapLumpIndex + 2; 146 | If (LineDefsLumpIndex > high(lumpinfo)) Or (lumpinfo[LineDefsLumpIndex].name <> 'LINEDEFS') Then exit; 147 | NumVertexes := W_LumpLength(VertexLumpIndex) Div sizeof(mapvertex_t); 148 | NumLineDefs := W_LumpLength(LineDefsLumpIndex) Div sizeof(maplinedef_t); 149 | setlength(MapVertexes, NumVertexes); 150 | setlength(MapLines, NumLineDefs); 151 | Vertexes := W_CacheLumpNum(VertexLumpIndex, 0); 152 | Lines := W_CacheLumpNum(LineDefsLumpIndex, 0); 153 | For i := 0 To high(MapVertexes) Do Begin 154 | MapVertexes[i].X := Vertexes^.x; 155 | MapVertexes[i].Y := Vertexes^.y; 156 | inc(Vertexes); 157 | If i = 0 Then Begin 158 | MinDim := MapVertexes[i]; 159 | MaxDim := MapVertexes[i]; 160 | End 161 | Else Begin 162 | MinDim.x := min(MinDim.x, MapVertexes[i].x); 163 | MinDim.y := min(MinDim.y, MapVertexes[i].y); 164 | MaxDim.x := max(MaxDim.x, MapVertexes[i].x); 165 | MaxDim.y := max(MaxDim.y, MapVertexes[i].y); 166 | End; 167 | End; 168 | MapWidth := MaxDim.X - MinDim.x; 169 | MapHeight := MaxDim.y - MinDim.y; 170 | For i := 0 To NumLineDefs - 1 Do Begin 171 | MapLines[i].v1 := lines^.v1; 172 | MapLines[i].v2 := lines^.v2; 173 | MapLines[i].flags := lines^.flags; 174 | MapLines[i].special := lines^.special; 175 | inc(Lines); 176 | End; 177 | // TODO: ggf noch die "Dinge" oder wenigstens die Spieler Startposition anzeigen ? 178 | CreatepreviewImage; 179 | result := true; 180 | End; 181 | 182 | End. 183 | 184 | -------------------------------------------------------------------------------- /src/WAD_Viewer/uwad_viewer.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of WAD_Viewer *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit uWAD_viewer; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils; 23 | 24 | Type 25 | TLumpType = ( 26 | ltUnknown, // Muss immer der 1. sein 27 | ltPatch, 28 | ltSound, 29 | ltMusic, 30 | ltMap, 31 | ltExportAsRaw, 32 | ltFlat, 33 | ltCount // Muss immer der letzte sein ! 34 | ); 35 | 36 | Var 37 | Doom8BitTo24RGBBit: Array[0..255] Of UInt32; 38 | 39 | Function GuessLumpTypeByPointer(Const p: Pointer; LumpName: String): TLumpType; 40 | 41 | Function LumpTypeToString(value: TLumpType): String; 42 | 43 | Implementation 44 | 45 | Uses v_patch, f_finale, w_wad; 46 | 47 | Function GuessLumpTypeByPointer(Const p: Pointer; LumpName: String): TLumpType; 48 | Const 49 | MusHeader = 50 | ord('M') Shl 0 51 | Or ord('U') Shl 8 52 | Or ord('S') Shl 16 53 | Or $1A Shl 24; 54 | 55 | Var 56 | patch: ^patch_t; 57 | column: Pcolumn_t; 58 | pui16: ^UInt16; 59 | pmus: ^Integer; 60 | s, t: String; 61 | i: Integer; 62 | valid: Boolean; 63 | LumpSize: integer; 64 | Begin 65 | result := ltUnknown; 66 | If Not assigned(p) Then exit; 67 | LumpSize := W_LumpLength(W_GetNumForName(LumpName)); 68 | 69 | // Check auf patch_t 70 | patch := p; 71 | If (patch^.width <= 640) And (patch^.width > 0) And 72 | (patch^.height <= 400) And (patch^.height > 0) Then Begin 73 | // Wir tun tatsächlich so als würden wir das Bild malen, und validieren so die daten.. 74 | valid := true; 75 | For i := 0 To patch^.width - 1 Do Begin 76 | column := Pointer(patch) + patch^.columnofs[i]; 77 | If (patch^.columnofs[i] > 0) And (patch^.columnofs[i] < LumpSize) Then Begin 78 | While (column^.topdelta <> $FF) And valid Do Begin 79 | If column^.topdelta + column^.length > patch^.height Then Begin 80 | valid := false; 81 | End; 82 | column := pointer(column) + column^.length + 4; 83 | If pointer(column) > Pointer(patch) + LumpSize Then Begin 84 | valid := false; 85 | End; 86 | End; 87 | End 88 | Else Begin 89 | valid := false; 90 | End; 91 | If Not valid Then break; 92 | End; 93 | If valid Then Begin 94 | result := ltPatch; 95 | exit; 96 | End; 97 | End; 98 | 99 | // Check for sound 100 | pui16 := P; 101 | If pui16^ = $0003 Then Begin 102 | inc(pui16); 103 | If (pui16^ = 11025) Or (pui16^ = 22050) Then Begin 104 | result := ltSound; 105 | exit; 106 | End; 107 | End; 108 | // Check for Music 109 | pmus := p; 110 | If pmus^ = MusHeader Then Begin 111 | result := ltMusic; 112 | exit; 113 | End; 114 | 115 | // Check for Map 116 | // Commercial Maps 117 | LumpName := uppercase(LumpName); 118 | If pos('MAP', LumpName) = 1 Then Begin 119 | s := Copy(LumpName, 4, length(LumpName)); 120 | If strtointdef(s, -1) In [0..99] Then Begin 121 | result := ltMap; 122 | exit; 123 | End; 124 | End; 125 | // Demo Maps Pattern E<num>M<num> 126 | If pos('E', LumpName) = 1 Then Begin 127 | s := copy(LumpName, 2, length(LumpName)); 128 | If pos('M', s) <> 0 Then Begin 129 | t := copy(s, 1, pos('M', s) - 1); 130 | If StrToIntDef(t, -1) >= 0 Then Begin 131 | t := copy(s, pos('M', s) + 1, length(s)); 132 | If StrToIntDef(t, -1) >= 0 Then Begin 133 | result := ltMap; 134 | exit; 135 | End; 136 | End; 137 | End; 138 | End; 139 | 140 | For i := 0 To high(textscreens) Do Begin 141 | If (uppercase(textscreens[i].Background) = UpperCase(LumpName)) And (Lumpsize = 64 * 64) Then Begin 142 | result := ltFlat; 143 | exit; 144 | End; 145 | End; 146 | 147 | 148 | // Als aller letztes noch den ein oder anderen "FLat" frei schalten, muss aber nicht unbedingt stimmen .. 149 | If W_LumpLength(W_GetNumForName(LumpName)) = 64 * 64 Then Begin 150 | result := ltFlat; 151 | End; 152 | End; 153 | 154 | Function LumpTypeToString(value: TLumpType): String; 155 | Begin 156 | result := ''; 157 | Case value Of 158 | ltUnknown: result := 'Unknown'; 159 | ltPatch: result := 'patch_t'; 160 | ltSound: Result := 'Sound'; 161 | ltMusic: result := 'Music'; 162 | ltMap: Result := 'Map'; 163 | ltFlat: result := 'Flat'; 164 | ltExportAsRaw: result := 'Export as RAW'; 165 | Else Begin 166 | Raise exception.create('LumpTypeToString, missing type in case!'); 167 | End; 168 | End; 169 | End; 170 | 171 | End. 172 | 173 | -------------------------------------------------------------------------------- /src/fpc_doom.lpr: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of OpenGL Clear Engine *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Program fpc_doom; 16 | 17 | {$MODE objfpc}{$H+} 18 | 19 | Uses 20 | {$IFDEF UNIX}{$IFDEF UseCThreads} 21 | cthreads, 22 | {$ENDIF}{$ENDIF} 23 | Interfaces, // this includes the LCL widgetset 24 | Forms, Unit1; 25 | 26 | Begin 27 | Application.Initialize; 28 | Application.CreateForm(TForm1, Form1); 29 | Application.Run; 30 | End. 31 | 32 | -------------------------------------------------------------------------------- /src/ufpc_doom_bass.pas: -------------------------------------------------------------------------------- 1 | (* 2 | * Auslagerung der Sound Engine in eine eigene Datei damit das nicht ganz so 3 | * Chaotisch ist ;) 4 | *) 5 | Unit ufpc_doom_bass; 6 | 7 | {$MODE ObjFPC}{$H+} 8 | 9 | Interface 10 | 11 | Uses 12 | Classes, SysUtils, bass, sounds; 13 | 14 | Type 15 | 16 | TSoundBuffer = Record 17 | Available: Boolean; // True = Verfügbar und Initialisiert 18 | Index: Integer; // Der UserPointer für Bass zurück in den FSoundBuffer Array 19 | DMXSoundBuf: PByte; // Die "Roh"daten 20 | DMXSoundBufLen: Integer; // Die Anzahl der Gültigen DatenBytes 21 | DMXSoundBufIndex: integer; // Der Index wieviel Byte Aktuell an Bass übermittelt wurden 22 | PreviewStream: HSTREAM; // Der Bass Stream wird im Constructor initialisiert 23 | End; 24 | 25 | { TBassSoundManager } 26 | 27 | TBassSoundManager = Class 28 | private 29 | fSoundBuffer: Array[0..integer(NUMSFX) - 1] Of TSoundBuffer; 30 | public 31 | Constructor Create(); virtual; 32 | Destructor Destroy(); override; 33 | Procedure StartSound(sfxinfo: Psfxinfo_t); 34 | End; 35 | 36 | Var 37 | BassSoundManager: TBassSoundManager = Nil; 38 | 39 | Implementation 40 | 41 | Uses 42 | i_sdlsound, i_system 43 | , w_wad 44 | ; 45 | Const 46 | PadLen = 32; 47 | 48 | Type 49 | // Quelle: https://doomwiki.org/wiki/Sound 50 | TDMXSound = Packed Record 51 | Format: UInt16; 52 | SampleRate: UInt16; 53 | NumberOfSamples: UInt32; 54 | PADDING1: Array[0..15] Of ShortInt; // Die ersten 16 und letzten 16 Byte werden nicht genutzt. 55 | SOUND: Array[0..high(Integer)] Of ShortInt; // Der ist also Gültig im Bereich [0..NumberOfSamples - PadLen - 1] 56 | // Padding2: Array [0..15] of ShortInt; 57 | End; 58 | 59 | // Hier kommt eine Angebliche Stack Overflow exception, wenn man das Überwacht aber eigentlich geht alles 1a .. 60 | 61 | Function GetPreviewData(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD{$IFDEF Windows} stdcall{$ELSE} cdecl{$ENDIF}; 62 | Var 63 | cnt: integer; 64 | src, buf: PByte; 65 | i, j: integer; 66 | Begin 67 | 68 | i := PInteger(user)^; 69 | buf := buffer; 70 | If (BassSoundManager.fSoundBuffer[i].DMXSoundBufIndex + length) < (BassSoundManager.fSoundBuffer[i].DMXSoundBufLen - 1) Then Begin 71 | cnt := length; 72 | End 73 | Else Begin 74 | cnt := (BassSoundManager.fSoundBuffer[i].DMXSoundBufLen) - (BassSoundManager.fSoundBuffer[i].DMXSoundBufIndex); 75 | End; 76 | src := BassSoundManager.fSoundBuffer[i].DMXSoundBuf; 77 | inc(src, BassSoundManager.fSoundBuffer[i].DMXSoundBufIndex); 78 | For j := 0 To cnt - 1 Do Begin 79 | buf^ := src^; 80 | inc(buf); 81 | inc(src); 82 | End; 83 | 84 | BassSoundManager.fSoundBuffer[i].DMXSoundBufIndex := BassSoundManager.fSoundBuffer[i].DMXSoundBufIndex + cnt; 85 | result := cnt; 86 | If cnt <> length Then Begin 87 | result := result Or BASS_STREAMPROC_END; 88 | End; 89 | End; 90 | 91 | { TBassSoundManager } 92 | 93 | Constructor TBassSoundManager.Create; 94 | Var 95 | i: integer; 96 | lumpIndex: integer; 97 | DMXSound: ^TDMXSound; 98 | Begin 99 | Inherited Create; 100 | For i := 0 To integer(NUMSFX) - 1 Do Begin 101 | lumpIndex := I_SDL_GetSfxLumpNum(@s_sfx[i]); 102 | fSoundBuffer[i].Available := lumpIndex <> -1; 103 | If fSoundBuffer[i].Available Then Begin 104 | DMXSound := W_CacheLumpNum(lumpIndex, 0); 105 | fSoundBuffer[i].Index := i; 106 | fSoundBuffer[i].DMXSoundBuf := @DMXSound^.SOUND[0]; 107 | fSoundBuffer[i].DMXSoundBufLen := DMXSound^.NumberOfSamples - PadLen; 108 | fSoundBuffer[i].DMXSoundBufIndex := 0; 109 | fSoundBuffer[i].PreviewStream := BASS_StreamCreate(DMXSound^.SampleRate, 1, BASS_SAMPLE_8BITS, @GetPreviewData, @fSoundBuffer[i].Index); 110 | End; 111 | End; 112 | End; 113 | 114 | Destructor TBassSoundManager.Destroy; 115 | Var 116 | i: integer; 117 | Begin 118 | For i := 0 To integer(NUMSFX) - 1 Do Begin 119 | If fSoundBuffer[i].Available Then Begin 120 | If BASS_ChannelIsActive(fSoundBuffer[i].PreviewStream) <> 0 Then Begin 121 | BASS_ChannelStop(fSoundBuffer[i].PreviewStream); 122 | End; 123 | BASS_StreamFree(fSoundBuffer[i].PreviewStream); 124 | End; 125 | fSoundBuffer[i].Available := false; 126 | End; 127 | End; 128 | 129 | Procedure TBassSoundManager.StartSound(sfxinfo: Psfxinfo_t); 130 | Var 131 | Index: Integer; 132 | Begin 133 | Index := (pointer(sfxinfo) - pointer(@s_sfx[0])) Div sizeof(s_sfx[0]); 134 | If Not fSoundBuffer[Index].Available Then exit; 135 | 136 | If BASS_ChannelIsActive(fSoundBuffer[Index].PreviewStream) <> 0 Then Begin 137 | BASS_ChannelStop(fSoundBuffer[Index].PreviewStream); 138 | End; 139 | fSoundBuffer[Index].DMXSoundBufIndex := 0; 140 | If Not BASS_ChannelPlay(fSoundBuffer[Index].PreviewStream, true) Then Begin 141 | I_Error('Unable to start sfx stream.'); 142 | End; 143 | End; 144 | 145 | Finalization 146 | If assigned(BassSoundManager) Then 147 | BassSoundManager.free; 148 | BassSoundManager := Nil; 149 | 150 | End. 151 | 152 | -------------------------------------------------------------------------------- /src/unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 323 3 | Height = 400 4 | Top = 107 5 | Width = 600 6 | ActiveControl = OpenGLControl1 7 | Caption = 'Form1' 8 | ClientHeight = 400 9 | ClientWidth = 600 10 | Position = poScreenCenter 11 | LCLVersion = '4.99.0.0' 12 | OnCreate = FormCreate 13 | object OpenGLControl1: TOpenGLControl 14 | Left = 8 15 | Height = 136 16 | Top = 8 17 | Width = 168 18 | OnKeyDown = OpenGLControl1KeyDown 19 | OnKeyUp = OpenGLControl1KeyUp 20 | OnMakeCurrent = OpenGLControl1MakeCurrent 21 | OnPaint = OpenGLControl1Paint 22 | OnResize = OpenGLControl1Resize 23 | end 24 | object Timer1: TTimer 25 | OnTimer = Timer1Timer 26 | Left = 24 27 | Top = 24 28 | end 29 | end 30 | -------------------------------------------------------------------------------- /src/units/a11y_weapon_pspr.pas: -------------------------------------------------------------------------------- 1 | Unit a11y_weapon_pspr; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Var 11 | a11y_sector_lighting: int = 1; 12 | a11y_extra_lighting: int = 0; 13 | a11y_weapon_flash: int = 1; 14 | a11y_weapon_pspr_: int = 1; 15 | a11y_palette_changes: int = 1; 16 | a11y_invul_colormap: int = 1; 17 | 18 | Implementation 19 | 20 | End. 21 | 22 | -------------------------------------------------------------------------------- /src/units/config.pas: -------------------------------------------------------------------------------- 1 | Unit config; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | Classes, SysUtils; 9 | 10 | Const 11 | 12 | (* Version number of package *) 13 | VERSION = '0.0.1'; 14 | 15 | (* Define to the full name of this package. *) 16 | PACKAGE_NAME = 'FPC Doom'; 17 | 18 | (* Define to the full name and version of this package. *) 19 | PACKAGE_STRING = 'FPC Doom ' + VERSION; 20 | 21 | (* Change this when you create your awesome forked version *) 22 | PROGRAM_PREFIX = 'FPC-'; 23 | 24 | Implementation 25 | 26 | End. 27 | 28 | -------------------------------------------------------------------------------- /src/units/d_event.pas: -------------------------------------------------------------------------------- 1 | Unit d_event; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , doomtype 10 | ; 11 | 12 | Const 13 | { buttoncode_t -> als constanten realisiert.} 14 | // Press "Fire". 15 | BT_ATTACK = 1; 16 | // Use button, to open doors, activate switches. 17 | BT_USE = 2; 18 | 19 | // Flag: game events, not really buttons. 20 | BT_SPECIAL = 128; 21 | BT_SPECIALMASK = 3; 22 | 23 | // Flag, weapon change pending. 24 | // If true, the next 3 bits hold weapon num. 25 | BT_CHANGE = 4; 26 | // The 3bit weapon mask and shift, convenience. 27 | BT_WEAPONMASK = (8 + 16 + 32); 28 | BT_WEAPONSHIFT = 3; 29 | 30 | // Pause the game. 31 | BTS_PAUSE = 1; 32 | // Save the game at each console. 33 | BTS_SAVEGAME = 2; 34 | 35 | // Savegame slot numbers 36 | // occupy the second byte of buttons. 37 | BTS_SAVEMASK = (4 + 8 + 16); 38 | BTS_SAVESHIFT = 2; 39 | 40 | // [crispy] demo joined. 41 | BT_JOIN = 64; 42 | 43 | // Event structure. 44 | Type 45 | 46 | // Input event types. 47 | evtype_t = 48 | ( 49 | // Key press/release events. 50 | // data1: Key code (from doomkeys.h) of the key that was 51 | // pressed or released. This is the key as it appears 52 | // on a US keyboard layout, and does not change with 53 | // layout. 54 | // For ev_keydown only: 55 | // data2: ASCII representation of the key that was pressed that 56 | // changes with the keyboard layout; eg. if 'Z' is 57 | // pressed on a German keyboard, data1='y',data2='z'. 58 | // Not affected by modifier keys. 59 | // data3: ASCII input, fully modified according to keyboard 60 | // layout and any modifier keys that are held down. 61 | // Only set if I_StartTextInput() has been called. 62 | ev_keydown, 63 | ev_keyup, 64 | 65 | // Mouse movement event. 66 | // data1: Bitfield of buttons currently held down. 67 | // (bit 0 = left; bit 1 = right; bit 2 = middle). 68 | // data2: X axis mouse movement (turn). 69 | // data3: Y axis mouse movement (forward/backward). 70 | ev_mouse, 71 | 72 | // Joystick state. 73 | // data1: Bitfield of buttons currently pressed. 74 | // data2: X axis mouse movement (turn). 75 | // data3: Y axis mouse movement (forward/backward). 76 | // data4: Third axis mouse movement (strafe). 77 | // data5: Fourth axis mouse movement (look) 78 | // data6: Dpad and analog stick direction. 79 | ev_joystick, 80 | 81 | // Quit event. Triggered when the user clicks the "close" button 82 | // to terminate the application. 83 | ev_quit 84 | ); 85 | 86 | event_t = Record 87 | 88 | _type: evtype_t; 89 | 90 | // Event-specific data; see the descriptions given above. 91 | data1, data2, data3, data4, data5, data6: int; 92 | End; 93 | Pevent_t = ^event_t; 94 | 95 | // 96 | // D_PostEvent 97 | // Called by the I/O functions when input is detected 98 | // 99 | Procedure D_PostEvent(Const ev: event_t); 100 | 101 | Function D_PopEvent(): Pevent_t; 102 | 103 | Function GetTypedEmptyEvent(Const aType: evtype_t): event_t; 104 | 105 | Implementation 106 | 107 | Uses 108 | ufifo; 109 | 110 | Const 111 | MAXEVENTS = 64; 112 | 113 | Type 114 | 115 | TEventFifo = specialize TBufferedFifo < Pevent_t > ; 116 | 117 | Var 118 | EventFifo: TEventFifo = Nil; 119 | 120 | Procedure D_PostEvent(Const ev: event_t); 121 | Var 122 | p: Pevent_t; 123 | Begin 124 | new(p); 125 | p^ := ev; 126 | EventFifo.Push(p); 127 | End; 128 | 129 | Function D_PopEvent(): Pevent_t; 130 | Begin 131 | If EventFifo.isempty Then Begin 132 | result := Nil; 133 | End 134 | Else Begin 135 | result := EventFifo.Pop; 136 | End; 137 | End; 138 | 139 | Function GetTypedEmptyEvent(Const aType: evtype_t): event_t; 140 | Begin 141 | FillChar(result, sizeof(result), 0); 142 | result._type := aType; 143 | End; 144 | 145 | Initialization 146 | EventFifo := TEventFifo.create(MAXEVENTS); 147 | 148 | Finalization 149 | EventFifo.free; 150 | EventFifo := Nil; 151 | 152 | End. 153 | 154 | -------------------------------------------------------------------------------- /src/units/d_items.pas: -------------------------------------------------------------------------------- 1 | Unit d_items; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , doomdef, info_types 10 | ; 11 | 12 | 13 | Type 14 | // Weapon info: sprite frames, ammunition use. 15 | weaponinfo_t = Record 16 | ammo: ammotype_t; 17 | upstate: statenum_t; 18 | downstate: statenum_t; 19 | readystate: statenum_t; 20 | atkstate: statenum_t; 21 | flashstate: statenum_t; 22 | End; 23 | 24 | Const 25 | 26 | // 27 | // PSPRITE ACTIONS for waepons. 28 | // This struct controls the weapon animations. 29 | // 30 | // Each entry is: 31 | // ammo/amunition type 32 | // upstate 33 | // downstate 34 | // readystate 35 | // atkstate, i.e. attack/fire/hit frame 36 | // flashstate, muzzle flash 37 | 38 | weaponinfo: Array[0..integer(NUMWEAPONS) - 1] Of weaponinfo_t = 39 | ( 40 | ( 41 | // fist 42 | ammo: am_noammo; 43 | upstate: S_PUNCHUP; 44 | downstate: S_PUNCHDOWN; 45 | readystate: S_PUNCH; 46 | atkstate: S_PUNCH1; 47 | flashstate: S_NULL 48 | ), 49 | ( 50 | // pistol 51 | ammo: am_clip; 52 | upstate: S_PISTOLUP; 53 | downstate: S_PISTOLDOWN; 54 | readystate: S_PISTOL; 55 | atkstate: S_PISTOL1; 56 | flashstate: S_PISTOLFLASH 57 | ), 58 | ( 59 | // shotgun 60 | ammo: am_shell; 61 | upstate: S_SGUNUP; 62 | downstate: S_SGUNDOWN; 63 | readystate: S_SGUN; 64 | atkstate: S_SGUN1; 65 | flashstate: S_SGUNFLASH1 66 | ), 67 | ( 68 | // chaingun 69 | ammo: am_clip; 70 | upstate: S_CHAINUP; 71 | downstate: S_CHAINDOWN; 72 | readystate: S_CHAIN; 73 | atkstate: S_CHAIN1; 74 | flashstate: S_CHAINFLASH1 75 | ), 76 | ( 77 | // missile launcher 78 | ammo: am_misl; 79 | upstate: S_MISSILEUP; 80 | downstate: S_MISSILEDOWN; 81 | readystate: S_MISSILE; 82 | atkstate: S_MISSILE1; 83 | flashstate: S_MISSILEFLASH1 84 | ), 85 | ( 86 | // plasma rifle 87 | ammo: am_cell; 88 | upstate: S_PLASMAUP; 89 | downstate: S_PLASMADOWN; 90 | readystate: S_PLASMA; 91 | atkstate: S_PLASMA1; 92 | flashstate: S_PLASMAFLASH1 93 | ), 94 | ( 95 | // bfg 9000 96 | ammo: am_cell; 97 | upstate: S_BFGUP; 98 | downstate: S_BFGDOWN; 99 | readystate: S_BFG; 100 | atkstate: S_BFG1; 101 | flashstate: S_BFGFLASH1 102 | ), 103 | ( 104 | // chainsaw 105 | ammo: am_noammo; 106 | upstate: S_SAWUP; 107 | downstate: S_SAWDOWN; 108 | readystate: S_SAW; 109 | atkstate: S_SAW1; 110 | flashstate: S_NULL 111 | ), 112 | ( 113 | // super shotgun 114 | ammo: am_shell; 115 | upstate: S_DSGUNUP; 116 | downstate: S_DSGUNDOWN; 117 | readystate: S_DSGUN; 118 | atkstate: S_DSGUN1; 119 | flashstate: S_DSGUNFLASH1 120 | ) 121 | ); 122 | 123 | Implementation 124 | 125 | End. 126 | 127 | -------------------------------------------------------------------------------- /src/units/d_mode.pas: -------------------------------------------------------------------------------- 1 | Unit d_mode; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | Classes, SysUtils; 9 | 10 | Type 11 | 12 | // The "mission" controls what game we are playing. 13 | GameMission_t = 14 | ( 15 | doom, // Doom 1 16 | doom2, // Doom 2 17 | pack_tnt, // Final Doom: TNT: Evilution 18 | pack_plut, // Final Doom: The Plutonia Experiment 19 | pack_chex, // Chex Quest (modded doom) 20 | pack_hacx, // Hacx (modded doom2) 21 | heretic, // Heretic 22 | hexen, // Hexen 23 | strife, // Strife 24 | doom2f, // Doom 2: L'Enfer sur Terre 25 | pack_nerve, // Doom 2: No Rest For The Living 26 | pack_master, // Master Levels for Doom 2 27 | 28 | none 29 | ); 30 | 31 | // The "mode" allows more accurate specification of the game mode we are 32 | // in: eg. shareware vs. registered. So doom1.wad and doom.wad are the 33 | // same mission, but a different mode. 34 | GameMode_t = 35 | ( 36 | shareware, // Doom/Heretic shareware 37 | registered, // Doom/Heretic registered 38 | commercial, // Doom II/Hexen 39 | retail, // Ultimate Doom 40 | indetermined // Unknown. 41 | ); 42 | 43 | // What version are we emulating? 44 | GameVersion_t = 45 | ( 46 | exe_doom_1_2, // Doom 1.2: shareware and registered 47 | exe_doom_1_5, // Doom 1.5: " 48 | exe_doom_1_666, // Doom 1.666: for shareware, registered and commercial 49 | exe_doom_1_7, // Doom 1.7/1.7a: " 50 | exe_doom_1_8, // Doom 1.8: " 51 | exe_doom_1_9, // Doom 1.9: " 52 | exe_hacx, // Hacx 53 | exe_ultimate, // Ultimate Doom (retail) 54 | exe_final, // Final Doom 55 | exe_final2, // Final Doom (alternate exe) 56 | exe_chex, // Chex Quest executable (based on Final Doom) 57 | 58 | exe_heretic_1_3, // Heretic 1.3 59 | 60 | exe_hexen_1_1, // Hexen 1.1 61 | exe_hexen_1_1r2, // Hexen 1.1 (alternate exe) 62 | exe_strife_1_2, // Strife v1.2 63 | exe_strife_1_31 // Strife v1.31 64 | ); 65 | 66 | // What IWAD variant are we using? 67 | GameVariant_t = 68 | ( 69 | vanilla, // Vanilla Doom 70 | freedoom, // FreeDoom: Phase 1 + 2 71 | freedm, // FreeDM 72 | bfgedition // Doom Classic (Doom 3: BFG Edition) 73 | ); 74 | 75 | // Skill level. 76 | skill_t = 77 | ( 78 | sk_noitems = -1, // the "-skill 0" hack 79 | sk_baby = 0, 80 | sk_easy, 81 | sk_medium, 82 | sk_hard, 83 | sk_nightmare 84 | ); 85 | 86 | Implementation 87 | 88 | End. 89 | 90 | -------------------------------------------------------------------------------- /src/units/d_net.pas: -------------------------------------------------------------------------------- 1 | Unit d_net; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , d_ticcmd 10 | ; 11 | 12 | Var 13 | netcmds: Array Of ticcmd_t; 14 | 15 | Procedure D_CheckNetGame(); 16 | 17 | Implementation 18 | 19 | Uses 20 | doomstat, doomdef, info_types 21 | , d_loop, d_main 22 | , g_game 23 | , m_Menu, m_argv 24 | , net_defs 25 | ; 26 | 27 | // Load game settings from the specified structure and 28 | // set global variables. 29 | 30 | Procedure LoadGameSettings(Const settings: net_gamesettings_t); 31 | Var 32 | i: unsigned_int; 33 | Begin 34 | deathmatch := settings.deathmatch; 35 | startepisode := settings.episode; 36 | startmap := settings.map; 37 | startskill := settings.skill; 38 | startloadgame := settings.loadgame; 39 | lowres_turn := settings.lowres_turn; 40 | nomonsters := settings.nomonsters; 41 | fastparm := settings.fast_monsters; 42 | respawnparm := settings.respawn_monsters; 43 | timelimit := settings.timelimit; 44 | consoleplayer := settings.consoleplayer; 45 | 46 | If (lowres_turn) Then Begin 47 | Writeln('NOTE: Turning resolution is reduced; this is probably ' + 48 | 'because there is a client recording a Vanilla demo.'); 49 | End; 50 | For i := 0 To MAXPLAYERS - 1 Do Begin 51 | playeringame[i] := i < settings.num_players; 52 | End; 53 | End; 54 | 55 | // Save the game settings from global variables to the specified 56 | // game settings structure. 57 | 58 | Procedure SaveGameSettings(Out settings: net_gamesettings_t); 59 | Begin 60 | // Fill in game settings structure with appropriate parameters 61 | // for the new game 62 | 63 | settings.deathmatch := deathmatch; 64 | settings.episode := startepisode; 65 | settings.map := startmap; 66 | settings.skill := startskill; 67 | settings.loadgame := startloadgame; 68 | settings.gameversion := gameversion; 69 | settings.nomonsters := nomonsters; 70 | settings.fast_monsters := fastparm; 71 | settings.respawn_monsters := respawnparm; 72 | settings.timelimit := timelimit; 73 | 74 | settings.lowres_turn := (M_ParmExists('-record') And (Not M_ParmExists('-longtics'))) 75 | Or M_ParmExists('-shorttics'); 76 | End; 77 | 78 | // Called when a player leaves the game 79 | 80 | Procedure PlayerQuitGame(Var player: player_t); 81 | Var 82 | player_num: unsigned_int; 83 | Begin 84 | // static char exitmsg[80]; 85 | // unsigned int player_num; 86 | // 87 | player_num := @player - @players[0]; 88 | 89 | // Do this the same way as Vanilla Doom does, to allow dehacked 90 | // replacements of this message 91 | 92 | playeringame[player_num] := false; 93 | players[consoleplayer].message := format('Player %d left the game', [player_num + 1]); 94 | // [crispy] don't interpolate players who left the game 95 | player.mo^.interp := 0; 96 | 97 | // TODO: check if it is sensible to do this: 98 | 99 | If (demorecording) Then Begin 100 | G_CheckDemoStatus(); 101 | End; 102 | End; 103 | 104 | 105 | Procedure RunTic(Const cmds: Tcmds; Var ingame: TInGame); 106 | Var 107 | i: unsigned_int; 108 | Begin 109 | 110 | // Check for player quits. 111 | For i := 0 To MAXPLAYERS - 1 Do Begin 112 | 113 | If (Not demoplayback) And (playeringame[i]) And (Not ingame[i]) Then Begin 114 | PlayerQuitGame(players[i]); 115 | End; 116 | End; 117 | 118 | netcmds := cmds; 119 | 120 | // check that there are players in the game. if not, we cannot 121 | // run a tic. 122 | 123 | If (advancedemo) Then D_DoAdvanceDemo(); 124 | 125 | G_Ticker(); 126 | End; 127 | 128 | Const 129 | doom_loop_interface: loop_interface_t = ( 130 | ProcessEvents: @D_ProcessEvents; 131 | BuildTiccmd: @G_BuildTiccmd; 132 | RunTic: @RunTic; 133 | RunMenu: @M_Ticker 134 | ) 135 | ; 136 | 137 | // 138 | // D_CheckNetGame 139 | // Works out player numbers among the net participants 140 | // 141 | 142 | Procedure D_CheckNetGame(); 143 | Var 144 | settings: net_gamesettings_t; 145 | Begin 146 | 147 | If (netgame) Then Begin 148 | autostart := true; 149 | End; 150 | 151 | D_RegisterLoopCallbacks(@doom_loop_interface); 152 | 153 | SaveGameSettings(settings); 154 | D_StartNetGame(settings, Nil); 155 | LoadGameSettings(settings); 156 | 157 | writeln(format('startskill %d deathmatch: %d startmap: %d startepisode: %d', 158 | [int(startskill), deathmatch, startmap, startepisode])); 159 | 160 | writeln(format('player %d of %d (%d nodes)', 161 | [consoleplayer + 1, settings.num_players, settings.num_players])); 162 | 163 | // Show players here; the server might have specified a time limit 164 | 165 | // if (timelimit > 0 && deathmatch) 166 | // { 167 | // // Gross hack to work like Vanilla: 168 | // 169 | // if (timelimit == 20 && M_CheckParm("-avg")) 170 | // { 171 | // DEH_printf("Austin Virtual Gaming: Levels will end " 172 | // "after 20 minutes\n"); 173 | // } 174 | // else 175 | // { 176 | // DEH_printf("Levels will end after %d minute", timelimit); 177 | // if (timelimit > 1) 178 | // printf("s"); 179 | // printf(".\n"); 180 | // } 181 | // } 182 | End; 183 | 184 | End. 185 | 186 | -------------------------------------------------------------------------------- /src/units/d_player.pas: -------------------------------------------------------------------------------- 1 | Unit d_player; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , net_defs, doomdef 10 | // The player data structure depends on a number 11 | // of other structs: items (internal inventory), 12 | // animation states (closely tied to the sprites 13 | // used to represent them, unfortunately). 14 | // #include "d_items.h" 15 | 16 | // Finally, for odd reasons, the player input 17 | // is buffered within the player data struct, 18 | // as commands per game tick. 19 | , d_ticcmd 20 | // #include "p_pspr.h" 21 | 22 | // In addition, the player is just a special 23 | // case of the generic moving object/actor. 24 | // , p_mobj 25 | 26 | ; 27 | 28 | Type 29 | // 30 | // Player states. 31 | // 32 | playerstate_t = ( 33 | // Playing or camping. 34 | PST_LIVE, 35 | // Dead on the ground, view follows killer. 36 | PST_DEAD, 37 | // Ready to restart/respawn??? 38 | PST_REBORN 39 | ); 40 | 41 | // 42 | // Player internal flags, for cheats and debug. 43 | // 44 | cheat_t = ( 45 | // No clipping, walk through barriers. 46 | CF_NOCLIP = 1, 47 | // No damage, no health loss. 48 | CF_GODMODE = 2, 49 | // Not really a cheat, just a debug aid. 50 | CF_NOMOMENTUM = 4, 51 | // [crispy] monsters don't target 52 | CF_NOTARGET = 8 53 | ); 54 | 55 | // player_t -> moved p_mobj 56 | 57 | // 58 | // INTERMISSION 59 | // Structure passed e.g. to WI_Start(wb) 60 | // 61 | wbplayerstruct_t = Record 62 | _in: boolean; // whether the player is in game 63 | // Player stats, kills, collected items etc. 64 | skills: int; 65 | sitems: int; 66 | ssecret: int; 67 | stime: int; 68 | frags: Array[0..3] Of int; // WTF: sollte das nicht an MAXPLAYERS hängen ? 69 | score: int; // current score on entry, modified on return 70 | End; 71 | Pwbplayerstruct_t = ^wbplayerstruct_t; 72 | 73 | wbstartstruct_t = Record 74 | 75 | epsd: int; // episode # (0-2) 76 | 77 | // if true, splash the secret level 78 | didsecret: boolean; 79 | 80 | // previous and next levels, origin 0 81 | last: int; 82 | next: int; 83 | 84 | maxkills: int; 85 | maxitems: int; 86 | maxsecret: int; 87 | maxfrags: int; 88 | 89 | // the par time 90 | partime: int; 91 | 92 | // index of this player in game 93 | pnum: int; 94 | 95 | plyr: Array[0..MAXPLAYERS - 1] Of wbplayerstruct_t; 96 | 97 | // [crispy] CPhipps - total game time for completed levels so far 98 | totaltimes: int; 99 | End; 100 | Pwbstartstruct_t = ^wbstartstruct_t; 101 | 102 | Implementation 103 | 104 | End. 105 | 106 | -------------------------------------------------------------------------------- /src/units/d_pwad.pas: -------------------------------------------------------------------------------- 1 | Unit d_pwad; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Procedure D_LoadSigilWads(); 11 | Procedure D_LoadNerveWad(); 12 | Procedure D_LoadMasterlevelsWad(); 13 | 14 | Implementation 15 | 16 | Procedure D_LoadSigilWads(); 17 | Begin 18 | 19 | End; 20 | 21 | Procedure D_LoadNerveWad(); 22 | Begin 23 | 24 | End; 25 | 26 | Procedure D_LoadMasterlevelsWad(); 27 | Begin 28 | 29 | End; 30 | 31 | End. 32 | 33 | -------------------------------------------------------------------------------- /src/units/d_think.pas: -------------------------------------------------------------------------------- 1 | Unit d_think; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | ; 10 | 11 | 12 | Implementation 13 | 14 | End. 15 | 16 | -------------------------------------------------------------------------------- /src/units/d_ticcmd.pas: -------------------------------------------------------------------------------- 1 | Unit d_ticcmd; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils, 9 | doomtype; 10 | 11 | Type 12 | 13 | // The data sampled per tick (single player) 14 | // and transmitted to other peers (multiplayer). 15 | // Mainly movements/button commands per game tick, 16 | // plus a checksum for internal state consistency. 17 | ticcmd_t = Record 18 | forwardmove: signed_char; // *2048 for move 19 | sidemove: signed_char; // *2048 for move 20 | angleturn: short; // <<16 for angle delta 21 | chatchar: byte; 22 | buttons: byte; 23 | // villsa [STRIFE] according to the asm, 24 | // consistancy is a short, not a byte 25 | consistancy: byte; // checks for net game 26 | 27 | // villsa - Strife specific: 28 | 29 | buttons2: byte; 30 | inventory: int; 31 | 32 | // Heretic/Hexen specific: 33 | 34 | lookfly: byte; // look/fly up/down/centering 35 | arti: byte; // artitype_t to use 36 | 37 | lookdir: int; 38 | End; 39 | Pticcmd_t = ^ticcmd_t; 40 | 41 | Implementation 42 | 43 | End. 44 | 45 | -------------------------------------------------------------------------------- /src/units/deh_doom.pas: -------------------------------------------------------------------------------- 1 | Unit deh_doom; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , deh_thing, deh_ptr; 10 | 11 | 12 | Const 13 | (* 14 | * Aktuell ist nur die .init Methode implementiert, und die gibt es bei den auskommentierten nicht.. 15 | *) 16 | deh_section_types: Array Of Pdeh_section_t = 17 | ( 18 | // &deh_section_ammo, 19 | // &deh_section_cheat, 20 | // &deh_section_frame, 21 | // &deh_section_misc, 22 | @deh_section_pointer, 23 | // &deh_section_sound, 24 | // &deh_section_text, 25 | @deh_section_thing 26 | // &deh_section_weapon, 27 | // &deh_section_bexstr, 28 | // &deh_section_bexpars, 29 | // &deh_section_bexptr, 30 | // &deh_section_bexincl, 31 | // 32 | ); 33 | 34 | Implementation 35 | 36 | End. 37 | 38 | -------------------------------------------------------------------------------- /src/units/deh_main.pas: -------------------------------------------------------------------------------- 1 | Unit deh_main; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , deh_doom; 10 | 11 | Procedure DEH_Init(); 12 | 13 | // If false, dehacked cheat replacements are ignored. 14 | 15 | Var 16 | deh_initialized: boolean = false; 17 | deh_apply_cheats: boolean = true; 18 | 19 | Implementation 20 | 21 | Uses 22 | m_argv 23 | ; 24 | 25 | Procedure InitializeSections(); 26 | Var 27 | i: integer; 28 | Begin 29 | For i := 0 To high(deh_section_types) Do Begin 30 | If (deh_section_types[i]^.init <> Nil) Then Begin 31 | deh_section_types[i]^.init(); 32 | End; 33 | End; 34 | End; 35 | 36 | Procedure DEH_Init(); // [crispy] un-static 37 | Begin 38 | //! 39 | // @category mod 40 | // 41 | // Ignore cheats in dehacked files. 42 | // 43 | 44 | If (M_CheckParm('-nocheats') > 0) Then Begin 45 | deh_apply_cheats := false; 46 | End; 47 | 48 | // Call init functions for all the section definitions. 49 | InitializeSections(); 50 | 51 | deh_initialized := true; 52 | End; 53 | 54 | End. 55 | 56 | -------------------------------------------------------------------------------- /src/units/deh_ptr.pas: -------------------------------------------------------------------------------- 1 | Unit deh_ptr; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , deh_thing, info_types 10 | ; 11 | // [BH] extra dehacked states 12 | Const 13 | EXTRASTATES = 1089; 14 | NUMSTATES = 4000; 15 | 16 | Var 17 | deh_section_pointer: deh_section_t; 18 | codeptrs: Array[0..NUMSTATES - 1] Of actionf_t; // [crispy] share with deh_bexptr.c 19 | 20 | Implementation 21 | 22 | Uses 23 | info 24 | ; 25 | 26 | Procedure DEH_PointerInit(); 27 | Var 28 | i: int; 29 | Begin 30 | // Initialize list of dehacked pointers 31 | For i := 0 To EXTRASTATES - 1 Do Begin 32 | codeptrs[i] := states[i].action; 33 | End; 34 | 35 | // [BH] Initialize extra dehacked states 36 | For i := EXTRASTATES To NUMSTATES - 1 Do Begin 37 | states[i].sprite := SPR_TNT1; 38 | states[i].frame := 0; 39 | states[i].tics := -1; 40 | states[i].action.acv := Nil; 41 | states[i].nextstate := statenum_t(i); 42 | states[i].misc1 := 0; 43 | states[i].misc2 := 0; 44 | // states[i].dehacked = false; 45 | codeptrs[i] := states[i].action; 46 | End; 47 | End; 48 | 49 | 50 | Initialization 51 | 52 | deh_section_pointer.name := 'Pointer'; 53 | deh_section_pointer.init := @DEH_PointerInit; // [crispy] initialize Thing extra properties 54 | // deh_section_pointer.start := @DEH_PointerStart; 55 | // deh_section_pointer.line_parser := @DEH_PointerParseLine; 56 | // deh_section_pointer._end := Nil; 57 | // deh_section_pointer.sha1_hash := @DEH_PointerSHA1Sum, 58 | 59 | End. 60 | 61 | -------------------------------------------------------------------------------- /src/units/deh_thing.pas: -------------------------------------------------------------------------------- 1 | Unit deh_thing; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | ; 10 | 11 | Type 12 | 13 | // typedef struct deh_context_s deh_context_t; 14 | //typedef struct deh_section_s deh_section_t; 15 | deh_section_init_t = Procedure(); 16 | //typedef void *(*deh_section_start_t)(deh_context_t *context, char *line); 17 | //typedef void (*deh_section_end_t)(deh_context_t *context, void *tag); 18 | //typedef void (*deh_line_parser_t)(deh_context_t *context, char *line, void *tag); 19 | //typedef void (*deh_sha1_hash_t)(sha1_context_t *context); 20 | 21 | deh_section_t = Record 22 | name: String; 23 | 24 | // Called on startup to initialize code 25 | 26 | init: deh_section_init_t; 27 | 28 | // This is called when a new section is started. The pointer 29 | // returned is used as a tag for the following calls. 30 | 31 | // deh_section_start_t start; 32 | 33 | // This is called for each line in the section 34 | 35 | // deh_line_parser_t line_parser; 36 | 37 | // This is called at the end of the section for any cleanup 38 | 39 | // deh_section_end_t end; 40 | 41 | // Called when generating an SHA1 sum of the dehacked state 42 | 43 | // deh_sha1_hash_t sha1_hash; 44 | End; 45 | Pdeh_section_t = ^deh_section_t; 46 | 47 | Var 48 | deh_section_thing: deh_section_t; 49 | 50 | Implementation 51 | 52 | Uses 53 | info, info_types 54 | , m_fixed 55 | ; 56 | 57 | // [crispy] initialize Thing extra properties (keeping vanilla props in info.c) 58 | 59 | Procedure DEH_InitThingProperties(); 60 | Var 61 | i: integer; 62 | Begin 63 | For i := 0 To int(NUMMOBJTYPES) - 1 Do Begin 64 | // [crispy] mobj id for item dropped on death 65 | Case mobjtype_t(i) Of 66 | MT_WOLFSS, 67 | MT_POSSESSED: Begin 68 | mobjinfo[i].droppeditem := MT_CLIP; 69 | End; 70 | 71 | MT_SHOTGUY: Begin 72 | mobjinfo[i].droppeditem := MT_SHOTGUN; 73 | End; 74 | 75 | MT_CHAINGUY: Begin 76 | mobjinfo[i].droppeditem := MT_CHAINGUN; 77 | End; 78 | Else 79 | mobjinfo[i].droppeditem := MT_NULL; 80 | End; 81 | 82 | // [crispy] distance to switch from missile to melee attack (generaliz. for Revenant) 83 | If (i = int(MT_UNDEAD)) Then 84 | mobjinfo[i].meleethreshold := 196 85 | Else 86 | mobjinfo[i].meleethreshold := 0; 87 | 88 | // [crispy] maximum distance range to start shooting (generaliz. for Arch Vile) 89 | If (i = int(MT_VILE)) Then 90 | mobjinfo[i].maxattackrange := 14 * 64 91 | Else 92 | mobjinfo[i].maxattackrange := 0; // unlimited 93 | 94 | // [crispy] minimum likelihood of a missile attack (generaliz. for Cyberdemon) 95 | If (i = int(MT_CYBORG)) Then 96 | mobjinfo[i].minmissilechance := 160 97 | Else 98 | mobjinfo[i].minmissilechance := 200; 99 | 100 | // [crispy] multiplier for missile firing chance (generaliz. from vanilla) 101 | If (i = int(MT_CYBORG)) 102 | Or (i = int(MT_SPIDER)) 103 | Or (i = int(MT_UNDEAD)) 104 | Or (i = int(MT_SKULL)) Then 105 | mobjinfo[i].missilechancemult := FRACUNIT Div 2 106 | Else 107 | mobjinfo[i].missilechancemult := FRACUNIT; 108 | End; 109 | End; 110 | 111 | Initialization 112 | 113 | deh_section_thing.name := 'Thing'; 114 | deh_section_thing.init := @DEH_InitThingProperties; // [crispy] initialize Thing extra properties 115 | // deh_section_thing.start := @DEH_ThingStart; 116 | // deh_section_thing.line_parser := @DEH_ThingParseLine; 117 | // deh_section_thing._end := Nil; 118 | // deh_section_thing.sha1_hash := @DEH_ThingSHA1Sum, 119 | 120 | End. 121 | 122 | -------------------------------------------------------------------------------- /src/units/doomdef.pas: -------------------------------------------------------------------------------- 1 | Unit doomdef; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , i_timer 10 | ; 11 | 12 | Const 13 | // The maximum number of players, multiplayer/networking. 14 | MAXPLAYERS = 4; // !! ACHTUNG !! es gibt auch eine Konstante die Heist NET_MAXPLAYERS und die ist 8 15 | 16 | // 17 | // Difficulty/skill settings/filters. 18 | // 19 | 20 | // Skill flags. 21 | MTF_EASY = 1; 22 | MTF_NORMAL = 2; 23 | MTF_HARD = 4; 24 | 25 | // Deaf monsters/do not react to sound. 26 | MTF_AMBUSH = 8; 27 | 28 | 29 | // 30 | // Power up durations, 31 | // how many seconds till expiration, 32 | // assuming TICRATE is 35 ticks/second. 33 | // 34 | INVULNTICS = (30 * TICRATE); 35 | INVISTICS = (60 * TICRATE); 36 | INFRATICS = (120 * TICRATE); 37 | IRONTICS = (60 * TICRATE); 38 | 39 | // Version code for cph's longtics hack ("v1.91") 40 | DOOM_191_VERSION = 111; 41 | 42 | // The current state of the game: whether we are 43 | // playing, gazing at the intermission screen, 44 | // the game final animation, or a demo. 45 | Type 46 | 47 | // 48 | // Key cards. 49 | // 50 | card_t = 51 | ( 52 | it_bluecard, 53 | it_yellowcard, 54 | it_redcard, 55 | it_blueskull, 56 | it_yellowskull, 57 | it_redskull, 58 | 59 | NUMCARDS 60 | ); 61 | 62 | // The defined weapons, 63 | // including a marker indicating 64 | // user has not changed weapon. 65 | weapontype_t = 66 | ( 67 | wp_fist, 68 | wp_pistol, 69 | wp_shotgun, 70 | wp_chaingun, 71 | wp_missile, 72 | wp_plasma, 73 | wp_bfg, 74 | wp_chainsaw, 75 | wp_supershotgun, 76 | 77 | NUMWEAPONS, 78 | 79 | // No pending weapon change. 80 | wp_nochange 81 | ); 82 | 83 | // Ammunition types defined. 84 | ammotype_t = 85 | ( 86 | am_clip, // Pistol / chaingun ammo. 87 | am_shell, // Shotgun / double barreled shotgun. 88 | am_cell, // Plasma rifle, BFG. 89 | am_misl, // Missile launcher. 90 | NUMAMMO, 91 | am_noammo // Unlimited for chainsaw / fist. 92 | ); 93 | 94 | gamestate_t = ( 95 | GS_NEG_1 = -1, // die FPC Variante für -1 96 | GS_LEVEL = 0, 97 | GS_INTERMISSION, 98 | GS_FINALE, 99 | GS_DEMOSCREEN 100 | ); 101 | 102 | gameaction_t = 103 | ( 104 | ga_nothing, 105 | ga_loadlevel, 106 | ga_newgame, 107 | ga_loadgame, 108 | ga_savegame, 109 | ga_playdemo, 110 | ga_completed, 111 | ga_victory, 112 | ga_worlddone, 113 | ga_screenshot 114 | ); 115 | 116 | // Power up artifacts. 117 | powertype_t = 118 | ( 119 | pw_invulnerability, 120 | pw_strength, 121 | pw_invisibility, 122 | pw_ironfeet, 123 | pw_allmap, 124 | pw_infrared, 125 | NUMPOWERS, 126 | // [crispy] showfps and mapcoords are now "powers" 127 | pw_showfps, 128 | pw_mapcoords 129 | ); 130 | 131 | Implementation 132 | 133 | End. 134 | 135 | -------------------------------------------------------------------------------- /src/units/doomkey.pas: -------------------------------------------------------------------------------- 1 | Unit doomkey; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils, LCLType; 9 | 10 | Const 11 | 12 | // 13 | // DOOM keyboard definition. 14 | // This is the stuff configured by Setup.Exe. 15 | // Most key data are simple ascii (uppercased). 16 | // 17 | KEY_RIGHTARROW = VK_RIGHT; 18 | KEY_LEFTARROW = VK_LEFT; 19 | KEY_UPARROW = VK_UP; 20 | KEY_DOWNARROW = VK_DOWN; 21 | KEY_ESCAPE = VK_ESCAPE; 22 | KEY_ENTER = VK_RETURN; 23 | KEY_TAB = VK_TAB; 24 | // #define KEY_F1 (0x80+0x3b) 25 | // #define KEY_F2 (0x80+0x3c) 26 | // #define KEY_F3 (0x80+0x3d) 27 | // #define KEY_F4 (0x80+0x3e) 28 | // #define KEY_F5 (0x80+0x3f) 29 | // #define KEY_F6 (0x80+0x40) 30 | // #define KEY_F7 (0x80+0x41) 31 | // #define KEY_F8 (0x80+0x42) 32 | // #define KEY_F9 (0x80+0x43) 33 | // #define KEY_F10 (0x80+0x44) 34 | // #define KEY_F11 (0x80+0x57) 35 | // #define KEY_F12 (0x80+0x58) 36 | // 37 | KEY_BACKSPACE = VK_BACK; 38 | KEY_PAUSE = VK_PAUSE; 39 | // 40 | // #define KEY_EQUALS 0x3d 41 | // #define KEY_MINUS 0x2d 42 | // 43 | KEY_RSHIFT = VK_LSHIFT; 44 | KEY_LSHIFT = VK_RSHIFT; 45 | // #define KEY_RCTRL (0x80+0x1d) 46 | KEY_RALT = 0; // Gibts in Lazarus überhaubt den ALT KEy ? 47 | // 48 | // #define KEY_LALT KEY_RALT 49 | // 50 | // // new keys: 51 | // 52 | KEY_CAPSLOCK = VK_CAPITAL; 53 | KEY_NUMLOCK = VK_NUMLOCK; 54 | KEY_SCRLCK = VK_SCROLL; // TODO: Stimmt der ? 55 | // #define KEY_PRTSCR (0x80+0x59) 56 | // 57 | // #define KEY_HOME (0x80+0x47) 58 | // #define KEY_END (0x80+0x4f) 59 | KEY_PGUP = VK_PRIOR; 60 | KEY_PGDN = VK_NEXT; 61 | // #define KEY_INS (0x80+0x52) 62 | // #define KEY_DEL (0x80+0x53) 63 | // 64 | // #define KEYP_0 KEY_INS 65 | // #define KEYP_1 KEY_END 66 | // #define KEYP_2 KEY_DOWNARROW 67 | // #define KEYP_3 KEY_PGDN 68 | // #define KEYP_4 KEY_LEFTARROW 69 | // #define KEYP_5 (0x80+0x4c) 70 | // #define KEYP_6 KEY_RIGHTARROW 71 | // #define KEYP_7 KEY_HOME 72 | // #define KEYP_8 KEY_UPARROW 73 | // #define KEYP_9 KEY_PGUP 74 | // 75 | // #define KEYP_DIVIDE '/' 76 | // #define KEYP_PLUS '+' 77 | // #define KEYP_MINUS '-' 78 | // #define KEYP_MULTIPLY '*' 79 | // #define KEYP_PERIOD 0 80 | // #define KEYP_EQUALS KEY_EQUALS 81 | // #define KEYP_ENTER KEY_ENTER 82 | 83 | Implementation 84 | 85 | End. 86 | 87 | -------------------------------------------------------------------------------- /src/units/doomstat.pas: -------------------------------------------------------------------------------- 1 | Unit doomstat; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , d_mode; 10 | 11 | Var 12 | // Game Mode - identify IWAD as shareware, retail etc. 13 | gamemode: GameMode_t = indetermined; 14 | gamemission: GameMission_t = doom; 15 | gameversion: GameVersion_t = exe_final2; 16 | gamevariant: GameVariant_t = vanilla; 17 | 18 | // Set if homebrew PWAD stuff has been added. 19 | modifiedgame: boolean = false; 20 | 21 | // ------------------------------------- 22 | // Scores, rating. 23 | // Statistics on a given map, for intermission. 24 | // 25 | totalkills: int; 26 | totalitems: int; 27 | totalsecret: int; 28 | extrakills: int; // [crispy] count spawned monsters 29 | 30 | // Timer, for scores. 31 | //extern int levelstarttic; // gametic at level start 32 | //extern int totalleveltimes; // [crispy] CPhipps - total time for all completed levels 33 | 34 | 35 | // Convenience macro. 36 | // 'gamemission' can be equal to pack_chex or pack_hacx, but these are 37 | // just modified versions of doom and doom2, and should be interpreted 38 | // as the same most of the time. 39 | 40 | Function logical_gamemission(): GameMission_t Inline; 41 | 42 | Implementation 43 | 44 | Function logical_gamemission(): GameMission_t; 45 | Begin 46 | If gamemission = pack_chex Then Begin 47 | result := doom; 48 | End 49 | Else Begin 50 | If gamemission = pack_hacx Then Begin 51 | result := doom2; 52 | End 53 | Else Begin 54 | result := gamemission; 55 | End; 56 | End; 57 | End; 58 | 59 | End. 60 | 61 | -------------------------------------------------------------------------------- /src/units/doomtype.pas: -------------------------------------------------------------------------------- 1 | Unit doomtype; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, config, Classes, SysUtils; 9 | 10 | Type 11 | pixel_t = uint8_t; // Alles in Doom ist 8-Bit -> Für OpenGL brauchen wir es in 24 / 32 Bit .. 12 | pixel_tArray = Array Of pixel_t; 13 | // dpixel_t = uint16_t; // -- Der wird nur fürs wipe gebraucht und dort als schweinerei .. 14 | 15 | Implementation 16 | 17 | End. 18 | 19 | -------------------------------------------------------------------------------- /src/units/dstrings.pas: -------------------------------------------------------------------------------- 1 | Unit dstrings; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | Classes, SysUtils; 9 | 10 | Const 11 | NUM_QUITMESSAGES = 8; 12 | 13 | SAVEGAMENAME = 'doomsav'; 14 | 15 | doom1_endmsg: Array Of String = 16 | ( 17 | 'are you sure you want to\nquit this great game?', 18 | 'please don''t leave, there''s more\ndemons to toast!', 19 | 'let''s beat it -- this is turning\ninto a bloodbath!', 20 | 'i wouldn''t leave if i were you.\ndos is much worse.', 21 | 'you''re trying to say you like dos\nbetter than me, right?', 22 | 'don''t leave yet -- there''s a\ndemon around that corner!', 23 | 'ya know, next time you come in here\ni''m gonna toast ya.', 24 | 'go ahead and leave. see if i care.' 25 | ); 26 | 27 | doom2_endmsg: Array Of String = 28 | ( 29 | // QuitDOOM II messages 30 | 'are you sure you want to\nquit this great game?', 31 | 'you want to quit?\nthen, thou hast lost an eighth!', 32 | 'don''t go now, there''s a \ndimensional shambler waiting\nat the dos prompt!', 33 | 'get outta here and go back\nto your boring programs.', 34 | 'if i were your boss, i''d \n deathmatch ya in a minute!', 35 | 'look, bud. you leave now\nand you forfeit your body count!', 36 | 'just leave. when you come\nback, i''ll be waiting with a bat.', 37 | 'you''re lucky i don''t smack\nyou for thinking about leaving.' 38 | ); 39 | 40 | Implementation 41 | 42 | End. 43 | 44 | -------------------------------------------------------------------------------- /src/units/f_wipe.pas: -------------------------------------------------------------------------------- 1 | Unit f_wipe; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , doomtype 10 | ; 11 | 12 | Const 13 | wipe_ColorXForm = 0; // simple gradual pixel change for 8-bit only 14 | wipe_Melt = 1; // weird screen melt 15 | 16 | Function wipe_StartScreen(x, y, width, height: int): int; 17 | 18 | Function wipe_EndScreen(x, y, width, height: int): int; 19 | 20 | Function wipe_ScreenWipe(wipeno, x, y, width, height, ticks: int): Boolean; 21 | 22 | Implementation 23 | 24 | Uses 25 | math 26 | , i_video 27 | , m_random 28 | , v_video 29 | ; 30 | 31 | Type 32 | TWipeFunction = Function(width, height, ticks: int): int; 33 | 34 | Var 35 | // when zero, stop the wipe 36 | go: boolean = false; 37 | wipe_scr_start: Array Of pixel_t = Nil; 38 | wipe_scr_end: Array Of pixel_t = Nil; 39 | wipe_scr: Array Of pixel_t = Nil; 40 | 41 | Function wipe_StartScreen(x, y, width, height: int): int; 42 | Begin 43 | If length(wipe_scr_start) <> SCREENWIDTH * SCREENHEIGHT Then Begin 44 | setlength(wipe_scr_start, SCREENWIDTH * SCREENHEIGHT); 45 | End; 46 | I_ReadScreen(wipe_scr_start); 47 | result := 0; 48 | End; 49 | 50 | Function wipe_EndScreen(x, y, width, height: int): int; 51 | Begin 52 | If length(wipe_scr_end) <> SCREENWIDTH * SCREENHEIGHT Then Begin 53 | setlength(wipe_scr_end, SCREENWIDTH * SCREENHEIGHT); 54 | End; 55 | I_ReadScreen(wipe_scr_end); 56 | // FillChar(wipe_scr_end[0], length(wipe_scr_end), 0); // DEBUG: to be removed makes the Wipe target screen black 57 | V_DrawBlock(x, y, width, height, wipe_scr_start); // restore start scr. 58 | result := 0; 59 | End; 60 | 61 | Function wipe_initColorXForm(width, height, ticks: int): int; 62 | Begin 63 | Raise exception.create('wipe: wipe_ColorXForm, nicht portiert.'); 64 | move(wipe_scr_start[0], wipe_scr[0], width * height * sizeof(pixel_t)); 65 | result := 0; 66 | End; 67 | 68 | Function wipe_doColorXForm(width, height, ticks: int): int; 69 | Begin 70 | // boolean changed; 71 | // pixel_t* w; 72 | // pixel_t* e; 73 | // int newval; 74 | // 75 | // changed = false; 76 | // w = wipe_scr; 77 | // e = wipe_scr_end; 78 | // 79 | // while (w!=wipe_scr+width*height) 80 | // { 81 | // if (*w != *e) 82 | // { 83 | // if (*w > *e) 84 | // { 85 | // newval = *w - ticks; 86 | // if (newval < *e) 87 | // *w = *e; 88 | // else 89 | // *w = newval; 90 | // changed = true; 91 | // } 92 | // else if (*w < *e) 93 | // { 94 | // newval = *w + ticks; 95 | // if (newval > *e) 96 | // *w = *e; 97 | // else 98 | // *w = newval; 99 | // changed = true; 100 | // } 101 | // } 102 | // w++; 103 | // e++; 104 | // } 105 | // 106 | // return !changed; 107 | End; 108 | 109 | Function wipe_exitColorXForm(width, height, ticks: int): int; 110 | Begin 111 | result := 0; 112 | End; 113 | 114 | Var 115 | y: Array Of int; 116 | 117 | Function wipe_initMelt(width, height, ticks: int): int; 118 | Var 119 | i, r: int; 120 | Begin 121 | // copy start screen to main screen 122 | move(wipe_scr_start[0], wipe_scr[0], width * height * sizeof(pixel_t)); 123 | // setup initial column positions 124 | // (y<0 => not ready to scroll yet) 125 | setlength(y, width); 126 | y[0] := -(M_Random.M_Random() Mod 16); 127 | For i := 1 To width - 1 Do Begin 128 | r := (M_Random.M_Random() Mod 3) - 1; 129 | y[i] := y[i - 1] + r; 130 | If (y[i] > 0) Then 131 | y[i] := 0 132 | Else If (y[i] = -16) Then 133 | y[i] := -15; 134 | End; 135 | result := 0; 136 | End; 137 | 138 | Function wipe_doMelt(width, height, ticks: int): int; 139 | Var 140 | i, j, dy: int; 141 | done: Boolean; 142 | Begin 143 | done := true; 144 | While (ticks <> 0) Do Begin // TODO: Wenn Ticks > 1, dann wird der Puffer unnötig oft hin und her kopiert, das könnte man "optimieren" 145 | (* 146 | * Der Originalcode konnte nicht sauber übersetzt werden, aber seine Funktionsweise verstanden 147 | * 1. wipe_initMelt belegt jede Spalte zufällig vor 148 | * 2. In wipe_doMelt werden die Spalten verschoben sobald ihre Timer >= 0 werden 149 | * 3. Das Verschieben ist zu anfangs "Langsam" und wird bis 16 pixel differenz immer schneller, dann bleibt es auf 16 150 | *) 151 | For i := 0 To width - 1 Do Begin 152 | If (y[i] < 0) Then Begin 153 | y[i] := y[i] + 1; 154 | done := false; 155 | End 156 | Else Begin 157 | If (y[i] < height) Then Begin 158 | If (y[i] < 16) Then Begin 159 | dy := y[i] + 1; 160 | End 161 | Else Begin 162 | dy := 16; 163 | End; 164 | y[i] := min(height, y[i] + dy); 165 | done := false; 166 | End; 167 | End; 168 | // Flickerfreies umkopieren der beiden Wipe Screens in den Framebuffer 169 | For j := 0 To height - 1 Do Begin 170 | If y[i] > j Then Begin 171 | wipe_scr[j * width + i] := wipe_scr_end[j * width + i]; 172 | End 173 | Else Begin 174 | If y[i] <= 0 Then Begin 175 | wipe_scr[j * width + i] := wipe_scr_start[j * width + i]; 176 | End 177 | Else Begin 178 | wipe_scr[j * width + i] := wipe_scr_start[(j - y[i]) * width + i]; 179 | End; 180 | End; 181 | End; 182 | End; 183 | dec(ticks); 184 | End; 185 | result := ord(done); 186 | End; 187 | 188 | Function wipe_exitMelt(width, height, ticks: int): int; 189 | Begin 190 | setlength(y, 0); 191 | setlength(wipe_scr_start, 0); 192 | setlength(wipe_scr_end, 0); 193 | result := 0; 194 | End; 195 | 196 | Function wipe_ScreenWipe(wipeno, x, y, width, height, ticks: int): boolean; 197 | Const 198 | wipes: Array Of TWipeFunction = ( 199 | @wipe_initColorXForm, @wipe_doColorXForm, @wipe_exitColorXForm, 200 | @wipe_initMelt, @wipe_doMelt, @wipe_exitMelt 201 | ); 202 | Var 203 | rc: int; 204 | Begin 205 | // initial stuff 206 | If (Not go) Then Begin 207 | 208 | go := true; 209 | // wipe_scr = (pixel_t *) Z_Malloc(width*height, PU_STATIC, 0); // DEBUG 210 | wipe_scr := I_VideoBuffer; 211 | wipes[wipeno * 3](width, height, ticks); // ruft wipe_initColorXForm oder wipe_initMelt auf 212 | End; 213 | 214 | // do a piece of wipe-in 215 | V_MarkRect(0, 0, width, height); 216 | rc := wipes[wipeno * 3 + 1](width, height, ticks); // ruft wipe_doColorXForm oder wipe_doMelt auf 217 | // V_DrawBlock(0, 0, width, height, wipe_scr); // DEBUG 218 | 219 | // final stuff 220 | If (rc <> 0) Then Begin 221 | go := false; 222 | wipes[wipeno * 3 + 2](width, height, ticks); // ruft wipe_exitColorXForm oder wipe_exitMelt auf 223 | End; 224 | 225 | result := Not go; 226 | End; 227 | 228 | End. 229 | 230 | -------------------------------------------------------------------------------- /src/units/hu_lib.pas: -------------------------------------------------------------------------------- 1 | Unit hu_lib; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , v_patch 10 | ; 11 | 12 | 13 | Const 14 | HU_MAXLINES = 4; 15 | HU_MAXLINELENGTH = 80; 16 | 17 | Type 18 | 19 | // Text Line widget 20 | // (parent of Scrolling Text and Input Text widgets) 21 | hu_textline_t = Record 22 | // left-justified position of scrolling text window 23 | x: int; 24 | y: int; 25 | 26 | f: PPPatch_t; // font 27 | sc: int; // start character 28 | l: String; // line of text 29 | len: int; // current line length 30 | 31 | // whether this line needs to be udpated 32 | needsupdate: int; 33 | End; 34 | phu_textline_t = ^hu_textline_t; 35 | 36 | // Scrolling Text window widget 37 | // (child of Text Line widget) 38 | hu_stext_t = Record 39 | 40 | l: Array[0..HU_MAXLINES - 1] Of hu_textline_t; // text lines to draw 41 | h: int; // height in lines 42 | cl: int; // current line number 43 | 44 | // pointer to boolean stating whether to update window 45 | _on: PBoolean; 46 | laston: boolean; // last value of *->on. 47 | End; 48 | Phu_stext_t = ^hu_stext_t; 49 | 50 | Procedure HUlib_addMessageToSText(s: Phu_stext_t; prefix, msg: String); 51 | Function HUlib_addCharToTextLine(t: Phu_textline_t; ch: char): boolean; 52 | 53 | Procedure HUlib_initSText(s: Phu_stext_t; x, y, h: int; font: PPpatch_t; startchar: int; _on: Pboolean); 54 | Procedure HUlib_initTextLine(t: Phu_textline_t; x, y: int; f: PPpatch_t; sc: int); 55 | 56 | Procedure HUlib_eraseSText(s: Phu_stext_t); 57 | Procedure HUlib_eraseTextLine(l: Phu_textline_t); 58 | Procedure HUlib_drawSText(s: Phu_stext_t); 59 | Procedure HUlib_drawTextLine(l: Phu_textline_t; drawcursor: boolean); 60 | 61 | Implementation 62 | 63 | Uses 64 | i_video 65 | , v_trans, v_video 66 | ; 67 | 68 | Procedure HUlib_clearTextLine(t: phu_textline_t); 69 | Begin 70 | t^.len := 0; 71 | t^.l := ''; 72 | t^.needsupdate := 1; 73 | End; 74 | 75 | Procedure HUlib_addLineToSText(s: Phu_stext_t); 76 | Var 77 | i: int; 78 | Begin 79 | 80 | // add a clear line 81 | If s^.cl + 1 = s^.h Then 82 | s^.cl := 0 83 | Else 84 | s^.cl := s^.cl + 1; 85 | HUlib_clearTextLine(@s^.l[s^.cl]); 86 | 87 | // everything needs updating 88 | For i := 0 To s^.h - 1 Do Begin 89 | s^.l[i].needsupdate := 4; 90 | End; 91 | End; 92 | 93 | Function HUlib_addCharToTextLine(t: Phu_textline_t; ch: char): boolean; 94 | Begin 95 | If (t^.len = HU_MAXLINELENGTH) Then Begin 96 | result := false; 97 | End 98 | Else Begin 99 | t^.l := t^.l + ch; 100 | t^.len := length(t^.l); 101 | t^.needsupdate := 4; 102 | result := true; 103 | End; 104 | End; 105 | 106 | Procedure HUlib_addMessageToSText(s: Phu_stext_t; prefix, msg: String); 107 | Var 108 | i: Integer; 109 | Begin 110 | HUlib_addLineToSText(s); 111 | If (prefix <> '') Then Begin 112 | For i := 1 To length(prefix) Do Begin 113 | HUlib_addCharToTextLine(@s^.l[s^.cl], prefix[i]); 114 | End; 115 | End; 116 | For i := 1 To length(msg) Do Begin 117 | HUlib_addCharToTextLine(@s^.l[s^.cl], msg[i]); 118 | End; 119 | End; 120 | 121 | Procedure HUlib_initTextLine(t: Phu_textline_t; x, y: int; f: PPpatch_t; sc: int 122 | ); 123 | Begin 124 | t^.x := x; 125 | t^.y := y; 126 | t^.f := f; 127 | t^.sc := sc; 128 | HUlib_clearTextLine(t); 129 | End; 130 | 131 | Procedure HUlib_initSText(s: Phu_stext_t; x, y, h: int; font: PPpatch_t; 132 | startchar: int; _on: Pboolean); 133 | Var 134 | i: int; 135 | Begin 136 | s^.h := h; 137 | s^._on := _on; 138 | s^.laston := true; 139 | s^.cl := 0; 140 | For i := 0 To h - 1 Do Begin 141 | HUlib_initTextLine(@s^.l[i], 142 | x, y - i * ((font[0]^.height) + 1), 143 | font, startchar); 144 | End; 145 | End; 146 | 147 | // sorta called by HU_Erase and just better darn get things straight 148 | 149 | Procedure HUlib_eraseTextLine(l: Phu_textline_t); 150 | Var 151 | lh, y, yoffset: int; 152 | Begin 153 | 154 | // Only erases when NOT in automap and the screen is reduced, 155 | // and the text must either need updating or refreshing 156 | // (because of a recent change back from the automap) 157 | 158 | // if (!automapactive && 159 | // viewwindowx && (l->needsupdate || crispy->cleanscreenshot || crispy->screenshotmsg == 4)) 160 | // { 161 | // lh = (SHORT(l->f[0]->height) + 1) << crispy->hires; 162 | // // [crispy] support line breaks 163 | // yoffset = 1; 164 | // for (y = 0; y < l->len; y++) 165 | // { 166 | // if (l->l[y] == '\n') 167 | // { 168 | // yoffset++; 169 | // } 170 | // } 171 | // lh *= yoffset; 172 | // for (y=(l->y << crispy->hires),yoffset=y*SCREENWIDTH ; y<(l->y << crispy->hires)+lh ; y++,yoffset+=SCREENWIDTH) 173 | // { 174 | // if (y < viewwindowy || y >= viewwindowy + viewheight) 175 | // R_VideoErase(yoffset, SCREENWIDTH); // erase entire line 176 | // else 177 | // { 178 | // R_VideoErase(yoffset, viewwindowx); // erase left border 179 | // R_VideoErase(yoffset + viewwindowx + scaledviewwidth, viewwindowx); 180 | // // erase right border 181 | // } 182 | // } 183 | // } 184 | 185 | If (l^.needsupdate <> 0) Then l^.needsupdate := l^.needsupdate - 1; 186 | End; 187 | 188 | Procedure HUlib_eraseSText(s: Phu_stext_t); 189 | Var 190 | i: int; 191 | Begin 192 | For i := 0 To s^.h - 1 Do Begin 193 | If (s^.laston) And (Not s^._on^) Then 194 | s^.l[i].needsupdate := 4; 195 | HUlib_eraseTextLine(@s^.l[i]); 196 | End; 197 | s^.laston := s^._on^; 198 | End; 199 | 200 | Procedure HUlib_drawTextLine(l: Phu_textline_t; drawcursor: boolean); 201 | Var 202 | i, w, x, y: int; 203 | c: char; 204 | Begin 205 | // draw the new stuff 206 | x := l^.x; 207 | y := l^.y; // [crispy] support line breaks 208 | i := 0; 209 | While i < l^.len Do Begin 210 | c := uppercase(l^.l[i + 1])[1]; 211 | // [crispy] support multi-colored text lines 212 | If (c = cr_esc) Then Begin 213 | If (l^.l[i + 2] >= '0') And (ord(l^.l[i + 2]) <= ord('0') + CRMAX - 1) Then Begin 214 | i := i + 1; 215 | If (crispy.coloredhud And COLOREDHUD_TEXT) <> 0 Then Begin 216 | dp_translation := cr[ord(l^.l[i + 1]) - ord('0')]; 217 | End 218 | Else Begin 219 | dp_translation := Nil; 220 | End; 221 | End; 222 | End 223 | // [crispy] support line breaks 224 | Else If (c = #13) Then Begin // '\n' 225 | x := l^.x; 226 | y := y + l^.f[0]^.height + 1; 227 | End 228 | // [crispy] support tab stops 229 | Else If (c = #9) Then Begin // '\t' 230 | x := x - (x - l^.x) Mod 12 + 12; 231 | If (x >= ORIGWIDTH + WIDESCREENDELTA) Then 232 | break; 233 | End 234 | Else If (c <> ' ') 235 | And (ord(c) >= l^.sc) 236 | And (c <= '_') Then Begin 237 | w := (l^.f[ord(c) - l^.sc]^.width); 238 | If (x + w > ORIGWIDTH + WIDESCREENDELTA) Then 239 | break; 240 | V_DrawPatchDirect(x, y, l^.f[ord(c) - l^.sc]); 241 | x := x + w; 242 | End 243 | Else Begin 244 | x := x + 4; 245 | If (x >= ORIGWIDTH + WIDESCREENDELTA) Then 246 | break; 247 | End; 248 | inc(i); 249 | End; 250 | 251 | // draw the cursor if requested 252 | If (drawcursor) 253 | And (x + SHORT(l^.f[ord('_') - l^.sc]^.width) <= ORIGWIDTH + WIDESCREENDELTA) Then Begin 254 | V_DrawPatchDirect(x, y, l^.f[ord('_') - l^.sc]); 255 | End; 256 | dp_translation := Nil; 257 | End; 258 | 259 | Procedure HUlib_drawSText(s: Phu_stext_t); 260 | Var 261 | i, idx: int; 262 | l: Phu_textline_t; 263 | Begin 264 | If (Not s^._on^) Then exit; // if not on, don't draw 265 | 266 | // draw everything 267 | 268 | For i := 0 To s^.h - 1 Do Begin 269 | 270 | idx := s^.cl - i; 271 | If (idx < 0) Then 272 | idx := idx + s^.h; // handle queue of lines 273 | 274 | l := @s^.l[idx]; 275 | 276 | // need a decision made here on whether to skip the draw 277 | HUlib_drawTextLine(l, false); // no cursor, please 278 | End; 279 | End; 280 | 281 | End. 282 | 283 | -------------------------------------------------------------------------------- /src/units/i_sdlsound.pas: -------------------------------------------------------------------------------- 1 | Unit i_sdlsound; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , sounds 10 | , d_mode 11 | ; 12 | 13 | Function I_SDL_InitSound(mission: GameMission_t): boolean; 14 | Procedure I_SDL_ShutdownSound(); 15 | 16 | Function I_SDL_GetSfxLumpNum(sfx: Psfxinfo_t): int; 17 | Function I_SDL_StartSound(sfxinfo: Psfxinfo_t; channel: int; vol: int; sep: int; pitch: int): int; 18 | 19 | Implementation 20 | 21 | Uses 22 | bass, ufpc_doom_bass 23 | , w_wad 24 | ; 25 | 26 | Var 27 | use_sfx_prefix: Boolean; 28 | sound_initialized: boolean = false; 29 | 30 | Procedure GetSfxLumpName(sfx: Psfxinfo_t; Var buf: String); 31 | Begin 32 | // Linked sfx lumps? Get the lump number for the sound linked to. 33 | If (sfx^.link <> Nil) Then Begin 34 | sfx := sfx^.link; 35 | End; 36 | 37 | // Doom adds a DS* prefix to sound lumps; Heretic and Hexen don't 38 | // do this. 39 | If (use_sfx_prefix) Then Begin 40 | buf := 'ds' + sfx^.name; 41 | // M_snprintf(buf, buf_len, "ds%s", DEH_String(sfx - > name)); 42 | End 43 | Else Begin 44 | // M_StringCopy(buf, DEH_String(sfx - > name), buf_len); 45 | buf := sfx^.name; 46 | End; 47 | End; 48 | 49 | Function I_SDL_GetSfxLumpNum(sfx: Psfxinfo_t): int; 50 | Var 51 | namebuf: String; 52 | Begin 53 | GetSfxLumpName(sfx, namebuf); 54 | result := W_CheckNumForName(namebuf); 55 | End; 56 | 57 | Function I_SDL_InitSound(mission: GameMission_t): boolean; 58 | Begin 59 | use_sfx_prefix := (mission = doom) Or (mission = strife); 60 | // // No sounds yet 61 | // for (i=0; i<NUM_CHANNELS; ++i) 62 | // { 63 | // channels_playing[i] = NULL; 64 | // } 65 | 66 | If (BASS_GetVersion() Shr 16) <> Bassversion Then Begin 67 | writeln(stderr, 'Unable to set up sound.'); 68 | result := false; 69 | End; 70 | If (Not Bass_init(-1, 44100, 0, {$IFDEF Windows}0{$ELSE}Nil{$ENDIF}, Nil)) Then Begin 71 | writeln(stderr, format('Error initialising SDL_mixer: %d', [BASS_ErrorGetCode()])); 72 | result := false; 73 | End; 74 | If assigned(BassSoundManager) Then BassSoundManager.free; 75 | BassSoundManager := TBassSoundManager.Create(); 76 | 77 | // Bass ist initialisiert, es fehlt nun der "Manager" zum Abspielen 78 | 79 | // ExpandSoundData = ExpandSoundData_SDL; 80 | // 81 | // Mix_QuerySpec(&mixer_freq, &mixer_format, &mixer_channels); 82 | // 83 | //#ifdef HAVE_LIBSAMPLERATE 84 | // if (use_libsamplerate != 0) 85 | // { 86 | // if (SRC_ConversionMode() < 0) 87 | // { 88 | // I_Error("I_SDL_InitSound: Invalid value for use_libsamplerate: %i", 89 | // use_libsamplerate); 90 | // } 91 | // 92 | // ExpandSoundData = ExpandSoundData_SRC; 93 | // } 94 | //#else 95 | // if (use_libsamplerate != 0) 96 | // { 97 | // fprintf(stderr, "I_SDL_InitSound: use_libsamplerate=%i, but " 98 | // "libsamplerate support not compiled in.\n", 99 | // use_libsamplerate); 100 | // } 101 | //#endif 102 | // 103 | // Mix_AllocateChannels(NUM_CHANNELS); 104 | // 105 | // SDL_PauseAudio(0); 106 | // 107 | sound_initialized := true; 108 | 109 | result := true; 110 | End; 111 | 112 | Procedure I_SDL_ShutdownSound(); 113 | Begin 114 | If Not sound_initialized Then exit; 115 | 116 | //Mix_CloseAudio(); 117 | //SDL_QuitSubSystem(SDL_INIT_AUDIO); 118 | BASS_Free; 119 | sound_initialized := false; 120 | End; 121 | 122 | Function I_SDL_StartSound(sfxinfo: Psfxinfo_t; channel: int; vol: int; 123 | sep: int; pitch: int): int; 124 | Begin 125 | If Not sound_initialized Then exit; 126 | BassSoundManager.StartSound(sfxinfo); 127 | result := 0; 128 | End; 129 | 130 | End. 131 | 132 | -------------------------------------------------------------------------------- /src/units/i_sound.pas: -------------------------------------------------------------------------------- 1 | Unit i_sound; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , sounds 10 | , d_mode 11 | ; 12 | 13 | Const 14 | // so that the individual game logic and sound driver code agree 15 | NORM_PITCH = 127; 16 | 17 | 18 | Procedure I_InitSound(mission: GameMission_t); 19 | Procedure I_ShutdownSound(); 20 | Function I_GetSfxLumpNum(sfxinfo: Psfxinfo_t): int; 21 | //Procedure I_UpdateSound(); 22 | //Procedure I_UpdateSoundParams(channel: int; vol: int; sep: int); 23 | Function I_StartSound(sfxinfo: Psfxinfo_t; channel: int; vol: int; sep: int; pitch: int): int; 24 | //Procedure I_StopSound(channel: int); 25 | //Function I_SoundIsPlaying(channel: int): boolean; 26 | //Procedure I_PrecacheSounds(Var sounds: sfxinfo_t; num_sounds: int); 27 | 28 | 29 | Procedure I_InitMusic(); 30 | //Procedure I_ShutdownMusic(); 31 | //Procedure I_SetMusicVolume(int volume); 32 | //Procedure I_PauseSong(); 33 | //Procedure I_ResumeSong(); 34 | //Function I_RegisterSong(data: Pointer, len: int): Pointer; 35 | //Procedure I_UnRegisterSong(handle: pointer); 36 | //Procedure I_PlaySong(handle: Pointer; looping: boolean); 37 | //Procedure I_StopSong(); 38 | //Function I_MusicIsPlaying(): boolean; 39 | 40 | //Function IsMid(Const mem: Array Of byte; len: int): boolean; 41 | //Function IsMus(Const mem: Array Of byte; len: int): boolean; 42 | 43 | Implementation 44 | 45 | Uses 46 | i_sdlsound 47 | ; 48 | 49 | // Find and initialize a sound_module_t appropriate for the setting 50 | // in snd_sfxdevice. 51 | 52 | Procedure InitSfxModule(mission: GameMission_t); 53 | Begin 54 | I_SDL_InitSound(mission); // TODO: das hier ist alles noch hacky .. 55 | // int i; 56 | // 57 | // sound_module = NULL; 58 | // 59 | // for (i=0; sound_modules[i] != NULL; ++i) 60 | // { 61 | // // Is the sfx device in the list of devices supported by 62 | // // this module? 63 | // 64 | // if (SndDeviceInList(snd_sfxdevice, 65 | // sound_modules[i]->sound_devices, 66 | // sound_modules[i]->num_sound_devices)) 67 | // { 68 | // // Initialize the module 69 | // 70 | // if (sound_modules[i]->Init(mission)) 71 | // { 72 | // sound_module = sound_modules[i]; 73 | // return; 74 | // } 75 | // } 76 | // } 77 | End; 78 | 79 | Procedure I_InitSound(mission: GameMission_t); 80 | Begin 81 | nop(); 82 | // boolean nosound, nosfx, nomusic, nomusicpacks; 83 | // 84 | // //! 85 | // // @vanilla 86 | // // 87 | // // Disable all sound output. 88 | // // 89 | // 90 | // nosound = M_CheckParm("-nosound") > 0; 91 | // 92 | // //! 93 | // // @vanilla 94 | // // 95 | // // Disable sound effects. 96 | // // 97 | // 98 | // nosfx = M_CheckParm("-nosfx") > 0; 99 | // 100 | // //! 101 | // // @vanilla 102 | // // 103 | // // Disable music. 104 | // // 105 | // 106 | // nomusic = M_CheckParm("-nomusic") > 0; 107 | // 108 | // //! 109 | // // 110 | // // Disable substitution music packs. 111 | // // 112 | // 113 | // nomusicpacks = M_ParmExists("-nomusicpacks"); 114 | // 115 | // // Auto configure the music pack directory. 116 | // M_SetMusicPackDir(); 117 | // 118 | // // Initialize the sound and music subsystems. 119 | // 120 | // if (!nosound && !screensaver_mode) 121 | // { 122 | // // This is kind of a hack. If native MIDI is enabled, set up 123 | // // the TIMIDITY_CFG environment variable here before SDL_mixer 124 | // // is opened. 125 | // 126 | // if (!nomusic 127 | // && (snd_musicdevice == SNDDEVICE_GENMIDI 128 | // || snd_musicdevice == SNDDEVICE_GUS)) 129 | // { 130 | // I_InitTimidityConfig(); 131 | // } 132 | // 133 | // if (!nosfx) 134 | // { 135 | InitSfxModule(mission); 136 | // } 137 | // 138 | // if (!nomusic) 139 | // { 140 | // InitMusicModule(); 141 | // active_music_module = music_module; 142 | // } 143 | // 144 | // // We may also have substitute MIDIs we can load. 145 | // if (!nomusicpacks && music_module != NULL) 146 | // { 147 | // music_packs_active = music_pack_module.Init(); 148 | // } 149 | // } 150 | // // [crispy] print the SDL audio backend 151 | // { 152 | // const char *driver_name = SDL_GetCurrentAudioDriver(); 153 | // 154 | // fprintf(stderr, "I_InitSound: SDL audio driver is %s\n", driver_name ? driver_name : "none"); 155 | // } 156 | End; 157 | 158 | Procedure I_ShutdownSound(); 159 | Begin 160 | // if (sound_module != NULL) 161 | // { 162 | { sound_module->} I_SDL_ShutdownSound; 163 | // } 164 | // 165 | // if (music_packs_active) 166 | // { 167 | // music_pack_module.Shutdown(); 168 | // } 169 | // 170 | //#ifndef DISABLE_SDL2MIXER 171 | // music_sdl_module.Shutdown(); 172 | // 173 | // if (music_module == &music_sdl_module) 174 | // { 175 | // return; 176 | // } 177 | //#endif 178 | // 179 | // if (music_module != NULL) 180 | // { 181 | // music_module->Shutdown(); 182 | // } 183 | End; 184 | 185 | Function I_GetSfxLumpNum(sfxinfo: Psfxinfo_t): int; 186 | Begin 187 | // if (sound_module != NULL) 188 | // { 189 | result := {sound_module->} I_SDL_GetSfxLumpNum(sfxinfo); 190 | // } 191 | // else 192 | // { 193 | // return 0; 194 | // } 195 | End; 196 | 197 | Procedure CheckVolumeSeparation(Var vol, sep: int); 198 | Begin 199 | // if (*sep < 0) 200 | // { 201 | // *sep = 0; 202 | // } 203 | // else if (*sep > 254) 204 | // { 205 | // *sep = 254; 206 | // } 207 | // 208 | // if (*vol < 0) 209 | // { 210 | // *vol = 0; 211 | // } 212 | // else if (*vol > 127) 213 | // { 214 | // *vol = 127; 215 | // } 216 | End; 217 | 218 | Function I_StartSound(sfxinfo: Psfxinfo_t; channel: int; vol: int; sep: int; 219 | pitch: int): int; 220 | Begin 221 | // if (sound_module != NULL) 222 | // { 223 | CheckVolumeSeparation(vol, sep); 224 | result := {sound_module->} I_SDL_StartSound(sfxinfo, channel, vol, sep, pitch); 225 | // } 226 | // else 227 | // { 228 | // return 0; 229 | // } 230 | End; 231 | 232 | Procedure I_InitMusic(); 233 | Begin 234 | 235 | End; 236 | 237 | End. 238 | 239 | -------------------------------------------------------------------------------- /src/units/i_system.pas: -------------------------------------------------------------------------------- 1 | Unit i_system; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Procedure I_PrintStartupBanner(gamedescription: String); 11 | Procedure I_PrintBanner(msg: String); 12 | Procedure I_Error(Error: String); 13 | Procedure I_Quit(); // Wenn Aufgerufen beendet sich die Anwending ohne weiteres Nachfragen 14 | Procedure I_GetMemoryValue(offset: unsigned_int; value: pointer; size: int); 15 | 16 | 17 | Procedure I_Tactile(_on: int; off: int; total: int); 18 | 19 | Implementation 20 | 21 | Uses config, Forms, bass 22 | , s_sound 23 | ; 24 | 25 | Procedure I_Error(Error: String); 26 | Begin 27 | Raise Exception.Create(error); 28 | halt; 29 | End; 30 | 31 | Procedure I_Quit(); 32 | Begin 33 | // D_QuitNetGame; 34 | // I_ShutdownGamepad; 35 | // I_ShutdownGraphics; 36 | // CloseLog; 37 | S_Shutdown(); 38 | // D_Endoom; 39 | // M_SaveDefaults; 40 | // G_CheckDemoStatusAtExit; 41 | Application.Terminate; 42 | End; 43 | 44 | Procedure I_GetMemoryValue(offset: unsigned_int; value: pointer; size: int); 45 | Begin 46 | Raise Exception.create('I_GetMemoryValue'); 47 | End; 48 | 49 | // Tactile feedback function, probably used for the Logitech Cyberman 50 | 51 | Procedure I_Tactile(_on: int; off: int; total: int); 52 | Begin 53 | // not implemented in Crispy DOOM 54 | End; 55 | 56 | Procedure I_PrintDivider(); 57 | Var 58 | i: Integer; 59 | Begin 60 | For i := 0 To 75 - 1 Do Begin 61 | write('='); 62 | End; 63 | WriteLn(''); 64 | End; 65 | 66 | Procedure I_PrintBanner(msg: String); 67 | Var 68 | spaces, i: Integer; 69 | Begin 70 | 71 | spaces := 35 - (length(msg) Div 2); 72 | 73 | For i := 0 To spaces - 1 Do Begin 74 | write(' '); 75 | End; 76 | 77 | WriteLn(msg); 78 | End; 79 | 80 | Procedure I_PrintStartupBanner(gamedescription: String); 81 | Begin 82 | I_PrintDivider(); 83 | I_PrintBanner(gamedescription); 84 | I_PrintDivider(); 85 | writeln( 86 | ' ' + PACKAGE_NAME + ' is free software, covered by the GNU General Public' + LineEnding + 87 | ' License. There is NO warranty; not even for MERCHANTABILITY or FITNESS' + LineEnding + 88 | ' FOR A PARTICULAR PURPOSE. You are welcome to change and distribute' + LineEnding + 89 | ' copies under certain conditions. See the source for more information.'); 90 | I_PrintDivider(); 91 | End; 92 | 93 | End. 94 | 95 | -------------------------------------------------------------------------------- /src/units/i_timer.pas: -------------------------------------------------------------------------------- 1 | Unit i_timer; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , m_fixed 10 | ; 11 | 12 | Const 13 | TICRATE = 35; 14 | 15 | // Called by D_DoomLoop, 16 | // returns current time in tics. 17 | Function I_GetTime(): int; 18 | 19 | // returns current time in ms 20 | Function I_GetTimeMS(): int; 21 | 22 | // returns current time in us 23 | //Function I_GetTimeUS(): uint64_t; // [crispy] 24 | 25 | // Pause for a specified number of ms 26 | Procedure I_Sleep(ms: int); 27 | 28 | // Initialize timer 29 | Procedure I_InitTimer(); 30 | 31 | // Wait for vertical retrace or pause a bit. 32 | Procedure I_WaitVBL(count: int); 33 | 34 | // [crispy] 35 | Function I_GetFracRealTime(): fixed_t; 36 | 37 | 38 | Implementation 39 | 40 | Var 41 | basetime: QWord = 0; 42 | // basecounter: uint64_t = 0; // [crispy] 43 | // basefreq: uint64_t = 0; // [crispy] 44 | 45 | Function I_GetTime(): int; 46 | Var 47 | ticks: QWord; 48 | Begin 49 | ticks := GetTickCount64(); 50 | If basetime = 0 Then Begin 51 | basetime := ticks; 52 | End; 53 | ticks := ticks - basetime; 54 | result := (ticks * TICRATE) Div 1000; 55 | End; 56 | 57 | Function I_GetTimeMS(): int; 58 | Var 59 | ticks: QWord; 60 | Begin 61 | ticks := GetTickCount64(); 62 | If basetime = 0 Then Begin 63 | basetime := ticks; 64 | End; 65 | result := ticks - basetime; 66 | End; 67 | 68 | Procedure I_Sleep(ms: int); 69 | Begin 70 | Sleep(ms); 71 | Raise exception.create('I_Sleep was called!'); 72 | End; 73 | 74 | Procedure I_InitTimer(); 75 | Begin 76 | // Nichts zu tun 77 | End; 78 | 79 | Procedure I_WaitVBL(count: int); 80 | Begin 81 | I_Sleep((count * 1000) Div 70); 82 | End; 83 | 84 | Function I_GetFracRealTime(): fixed_t; 85 | Begin 86 | result := I_GetTimeMS() * TICRATE Mod 1000 * FRACUNIT Div 1000; 87 | End; 88 | 89 | End. 90 | 91 | -------------------------------------------------------------------------------- /src/units/m_argv.pas: -------------------------------------------------------------------------------- 1 | Unit m_argv; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Var 11 | 12 | myargc: int; 13 | myargv: Array Of String; 14 | exedir: String; 15 | 16 | Procedure M_SetExeDir(); 17 | 18 | // Returns the position of the given parameter 19 | // in the arg list (0 if not found). 20 | Function M_CheckParm(Const check: String): int; 21 | 22 | // Same as M_CheckParm, but checks that num_args arguments are available 23 | // following the specified argument. 24 | Function M_CheckParmWithArgs(check: String; num_args: integer): int; 25 | 26 | Procedure M_FindResponseFile(); 27 | 28 | // Parameter has been specified? 29 | 30 | Function M_ParmExists(Const check: String): Boolean; 31 | 32 | Function M_GetExecutableName(): String; 33 | 34 | Implementation 35 | 36 | Procedure M_SetExeDir(); 37 | Begin 38 | exedir := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0))); 39 | End; 40 | 41 | Function M_CheckParm(Const check: String): int; 42 | Begin 43 | result := M_CheckParmWithArgs(check, 0); 44 | End; 45 | 46 | // 47 | // M_CheckParm 48 | // Checks for the given parameter 49 | // in the program's command line arguments. 50 | // Returns the argument number (1 to argc-1) 51 | // or 0 if not present 52 | // 53 | 54 | Function M_CheckParmWithArgs(check: String; num_args: integer): int; 55 | Var 56 | i: Integer; 57 | Begin 58 | result := 0; 59 | For i := 1 To ParamCount - num_args Do Begin 60 | If check = ParamStr(i) Then result := i; 61 | End 62 | End; 63 | 64 | Procedure M_FindResponseFile(); 65 | Begin 66 | // int i; 67 | // 68 | // for (i = 1; i < myargc; i++) 69 | // { 70 | // if (myargv[i][0] == '@') 71 | // { 72 | // LoadResponseFile(i, myargv[i] + 1); 73 | // } 74 | // } 75 | // 76 | // for (;;) 77 | // { 78 | // //! 79 | // // @arg <filename> 80 | // // 81 | // // Load extra command line arguments from the given response file. 82 | // // Arguments read from the file will be inserted into the command 83 | // // line replacing this argument. A response file can also be loaded 84 | // // using the abbreviated syntax '@filename.rsp'. 85 | // // 86 | // i = M_CheckParmWithArgs("-response", 1); 87 | // if (i <= 0) 88 | // { 89 | // break; 90 | // } 91 | // // Replace the -response argument so that the next time through 92 | // // the loop we'll ignore it. Since some parameters stop reading when 93 | // // an argument beginning with a '-' is encountered, we keep something 94 | // // that starts with a '-'. 95 | // free(myargv[i]); 96 | // myargv[i] = M_StringDuplicate("-_"); 97 | // LoadResponseFile(i + 1, myargv[i + 1]); 98 | // } 99 | End; 100 | 101 | // 102 | // M_ParmExists 103 | // 104 | // Returns true if the given parameter exists in the program's command 105 | // line arguments, false if not. 106 | // 107 | 108 | Function M_ParmExists(Const check: String): Boolean; 109 | Begin 110 | result := M_CheckParm(check) <> 0; 111 | End; 112 | 113 | Function M_GetExecutableName(): String; 114 | Begin 115 | result := ExtractFileName(ParamStr(0)); 116 | End; 117 | 118 | End. 119 | 120 | -------------------------------------------------------------------------------- /src/units/m_bbox.pas: -------------------------------------------------------------------------------- 1 | Unit m_bbox; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , m_fixed 10 | ; 11 | 12 | // Bounding box coordinate storage. 13 | Const 14 | BOXTOP = 0; 15 | BOXBOTTOM = 1; 16 | BOXLEFT = 2; 17 | BOXRIGHT = 3; 18 | // bbox coordinates 19 | 20 | // Bounding box functions. 21 | Procedure M_ClearBox(Out box: Array Of fixed_t); 22 | 23 | Procedure M_AddToBox(Var box: Array Of fixed_t; x, y: fixed_t); 24 | 25 | Implementation 26 | 27 | Procedure M_ClearBox(Out box: Array Of fixed_t); 28 | Begin 29 | box[BOXTOP] := INT_MIN; 30 | box[BOXRIGHT] := INT_MIN; 31 | box[BOXBOTTOM] := INT_MAX; 32 | box[BOXLEFT] := INT_MAX; 33 | End; 34 | 35 | Procedure M_AddToBox(Var box: Array Of fixed_t; x, y: fixed_t); 36 | Begin 37 | If (x < box[BOXLEFT]) Then box[BOXLEFT] := x; 38 | If (x > box[BOXRIGHT]) Then box[BOXRIGHT] := x; 39 | If (y < box[BOXBOTTOM]) Then box[BOXBOTTOM] := y; 40 | If (y > box[BOXTOP]) Then box[BOXTOP] := y; 41 | End; 42 | 43 | End. 44 | 45 | -------------------------------------------------------------------------------- /src/units/m_cheat.pas: -------------------------------------------------------------------------------- 1 | Unit m_cheat; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Type 11 | cheatseq_t = Record 12 | // settings for this cheat 13 | sequence: String; 14 | parameter_chars: int; 15 | 16 | // state used during the game 17 | chars_read: int; 18 | param_chars_read: int; 19 | parameter_buf: String; 20 | End; 21 | 22 | Function cht_CheckCheat(Var cht: cheatseq_t; key: char): int; 23 | Procedure cht_GetParam(Var cht: cheatseq_t; Out buffer: String); 24 | 25 | Implementation 26 | 27 | // 28 | // Called in st_stuff module, which handles the input. 29 | // Returns a 1 if the cheat was successful, 0 if failed. 30 | // 31 | 32 | Function cht_CheckCheat(Var cht: cheatseq_t; key: char): int; 33 | Begin 34 | key := lowercase(key); // Alle Cheats sind immer in kleinbuchstaben geschrieben ! 35 | // cheat not matched yet 36 | result := 0; 37 | 38 | If (cht.chars_read < length(cht.sequence)) Then Begin 39 | // still reading characters from the cheat code 40 | // and verifying. reset back to the beginning 41 | // if a key is wrong 42 | 43 | If (key = cht.sequence[cht.chars_read + 1]) Then 44 | cht.chars_read := cht.chars_read + 1 45 | Else 46 | cht.chars_read := 0; 47 | 48 | cht.param_chars_read := 0; 49 | cht.parameter_buf := ''; 50 | End 51 | Else If (cht.param_chars_read < cht.parameter_chars) Then Begin 52 | // we have passed the end of the cheat sequence and are 53 | // entering parameters now 54 | cht.parameter_buf := cht.parameter_buf + key; 55 | cht.param_chars_read := cht.param_chars_read + 1; 56 | End; 57 | 58 | If (cht.chars_read >= length(cht.sequence)) 59 | And (cht.param_chars_read >= cht.parameter_chars) Then Begin 60 | cht.chars_read := 0; 61 | cht.param_chars_read := 0; 62 | result := 1; 63 | End; 64 | 65 | End; 66 | 67 | Procedure cht_GetParam(Var cht: cheatseq_t; Out buffer: String); 68 | Begin 69 | buffer := cht.parameter_buf; 70 | End; 71 | 72 | End. 73 | 74 | -------------------------------------------------------------------------------- /src/units/m_config.pas: -------------------------------------------------------------------------------- 1 | Unit m_config; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Procedure M_SetConfigDir(Const dir: String); 11 | Procedure M_MakeDirectory(Const dir: String); 12 | Procedure M_LoadDefaults(); 13 | Procedure M_SetConfigFilenames(Const main_config: String; Const extra_config: String); 14 | 15 | Function M_GetSaveGameDir(iwadname: String): String; 16 | 17 | Implementation 18 | 19 | Uses m_argv; 20 | 21 | Var 22 | configdir: String = ''; 23 | 24 | // Default filenames for configuration files. 25 | 26 | default_main_config: String; 27 | default_extra_config: String; 28 | 29 | // 30 | // SetConfigDir: 31 | // 32 | // Sets the location of the configuration directory, where configuration 33 | // files are stored - default.cfg, chocolate-doom.cfg, savegames, etc. 34 | // 35 | 36 | Procedure M_SetConfigDir(Const dir: String); 37 | Begin 38 | // Use the directory that was passed, or find the default. 39 | 40 | If (dir <> '') Then Begin 41 | configdir := dir; 42 | End 43 | Else Begin 44 | configdir := GetAppConfigDir(false); 45 | End; 46 | 47 | If (configdir <> exedir) Then Begin 48 | writeln(format('Using %s for configuration and saves', [configdir])); 49 | End; 50 | 51 | // Make the directory if it doesn't already exist: 52 | 53 | M_MakeDirectory(configdir); 54 | End; 55 | 56 | Procedure M_MakeDirectory(Const dir: String); 57 | Begin 58 | ForceDirectories(dir); 59 | End; 60 | 61 | Procedure M_LoadDefaults(); 62 | Var 63 | i: int; 64 | Begin 65 | 66 | // 67 | // // This variable is a special snowflake for no good reason. 68 | // M_BindStringVariable("autoload_path", &autoload_path); 69 | // 70 | // check for a custom default file 71 | 72 | //! 73 | // @arg <file> 74 | // @vanilla 75 | // 76 | // Load main configuration from the specified file, instead of the 77 | // default. 78 | // 79 | 80 | i := M_CheckParmWithArgs('-config', 1); 81 | 82 | If (i <> 0) Then Begin 83 | // doom_defaults.filename = myargv[i+1]; 84 | // printf (" default file: %s\n",doom_defaults.filename); 85 | End 86 | Else Begin 87 | // doom_defaults.filename 88 | // = M_StringJoin(configdir, default_main_config, NULL); 89 | End; 90 | 91 | // printf("saving config in %s\n", doom_defaults.filename); 92 | 93 | //! 94 | // @arg <file> 95 | // 96 | // Load additional configuration from the specified file, instead of 97 | // the default. 98 | // 99 | 100 | i := M_CheckParmWithArgs('-extraconfig', 1); 101 | 102 | If (i <> 0) Then Begin 103 | // extra_defaults.filename = myargv[i+1]; 104 | // printf(" extra configuration file: %s\n", 105 | // extra_defaults.filename); 106 | End 107 | Else Begin 108 | // extra_defaults.filename 109 | // = M_StringJoin(configdir, default_extra_config, NULL); 110 | End; 111 | 112 | // LoadDefaultCollection(&doom_defaults); 113 | // LoadDefaultCollection(&extra_defaults); 114 | End; 115 | 116 | 117 | // Set the default filenames to use for configuration files. 118 | 119 | Procedure M_SetConfigFilenames(Const main_config: String; 120 | Const extra_config: String); 121 | Begin 122 | default_main_config := main_config; 123 | default_extra_config := extra_config; 124 | End; 125 | 126 | Function M_GetSaveGameDir(iwadname: String): String; 127 | Var 128 | p: int; 129 | savegamedir, topdir: String; 130 | Begin 131 | 132 | //! 133 | // @arg <directory> 134 | // 135 | // Specify a path from which to load and save games. If the directory 136 | // does not exist then it will automatically be created. 137 | // 138 | 139 | p := M_CheckParmWithArgs('-savedir', 1); 140 | If (p <> 0) Then Begin 141 | savegamedir := myargv[p + 1]; 142 | If (Not DirectoryExists(savegamedir)) Then Begin 143 | ForceDirectories(savegamedir); 144 | End; 145 | 146 | // add separator at end just in case 147 | savegamedir := IncludeTrailingPathDelimiter(savegamedir); 148 | 149 | writeln(format('Save directory changed to %s.', [savegamedir])); 150 | End 151 | //#ifdef _WIN32 152 | // // In -cdrom mode, we write savegames to a specific directory 153 | // // in addition to configs. 154 | // 155 | // else if (M_ParmExists("-cdrom")) 156 | // { 157 | // savegamedir = M_StringDuplicate(configdir); 158 | // } 159 | //#endif 160 | // // If not "doing" a configuration directory (Windows), don't "do" 161 | // // a savegame directory, either. 162 | // else if (!strcmp(configdir, exedir)) 163 | // { 164 | // savegamedir = M_StringDuplicate(""); 165 | // } 166 | Else Begin 167 | // ~/.local/share/chocolate-doom/savegames 168 | topdir := IncludeTrailingPathDelimiter(GetAppConfigDir(false)) + 'savegames'; 169 | ForceDirectories(topdir); 170 | 171 | // eg. ~/.local/share/chocolate-doom/savegames/doom2.wad/ 172 | 173 | savegamedir := IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(topdir) + iwadname); 174 | ForceDirectories(savegamedir); 175 | End; 176 | result := savegamedir; 177 | End; 178 | 179 | End. 180 | 181 | -------------------------------------------------------------------------------- /src/units/m_fixed.pas: -------------------------------------------------------------------------------- 1 | Unit m_fixed; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | // 11 | // Fixed point, 32bit as 16.16. 12 | // 13 | Const 14 | FRACBITS = 16; 15 | FRACUNIT = (1 Shl FRACBITS); 16 | 17 | Function FixedMul(a, b: fixed_t): fixed_t; 18 | Function FixedDiv(a, b: fixed_t): fixed_t; 19 | 20 | Function FIXED2DOUBLE(x: int): fixed_t; 21 | 22 | Implementation 23 | 24 | Uses math; 25 | 26 | Function FixedMul(a, b: fixed_t): fixed_t; 27 | Var 28 | t: int64; 29 | Begin 30 | t := int64_t(a) * int64_t(b); 31 | result := fixed_t(SarInt64(t, FRACBITS)); // das ist ein Vorzeichen korrektes shr 32 | End; 33 | 34 | Function FixedDiv(a, b: fixed_t): fixed_t; 35 | Var 36 | res: Int64; 37 | Begin 38 | If ((SarLongint(abs(a), 14)) >= abs(b)) Then Begin // Hier ist das Vorzeichen egal deswegen braucht es kein SarLongint 39 | result := IfThen((a Xor b) < 0, INT_MIN, INT_MAX); 40 | End 41 | Else Begin 42 | res := (int64(a) Shl FRACBITS) Div b; 43 | result := fixed_t(res); 44 | End; 45 | End; 46 | 47 | Function FIXED2DOUBLE(x: int): fixed_t; 48 | Begin 49 | result := (x Div FRACUNIT); 50 | End; 51 | 52 | End. 53 | 54 | -------------------------------------------------------------------------------- /src/units/m_misc.pas: -------------------------------------------------------------------------------- 1 | Unit m_misc; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Function M_StringDuplicate(Const orig: String): String; 11 | Function M_FileCaseExists(Const path: String): String; 12 | 13 | Implementation 14 | 15 | Uses lazFileUtils; 16 | 17 | Function M_StringDuplicate(Const orig: String): String; 18 | Begin 19 | result := Orig; 20 | End; 21 | 22 | Function M_FileCaseExists(Const path: String): String; 23 | Var 24 | name, ext: String; 25 | Begin 26 | result := ''; 27 | If FileExists(path) Then exit(path); 28 | // 1: lowercase filename, e.g. doom2.wad 29 | If FileExists(LowerCase(path)) Then exit(LowerCase(path)); 30 | // 2: uppercase filename, e.g. DOOM2.WAD 31 | If FileExists(UpperCase(path)) Then exit(UpperCase(path)); 32 | // 3. uppercase basename with lowercase extension, e.g. DOOM2.wad 33 | name := ExtractFileNameWithoutExt(path); 34 | ext := ExtractFileExt(path); 35 | If FileExists(UpperCase(name) + LowerCase(ext)) Then exit(UpperCase(name) + LowerCase(ext)); 36 | // 4. lowercase filename with uppercase first letter, e.g. Doom2.wad 37 | If length(name) > 0 Then Begin 38 | name := LowerCase(name); 39 | name[1] := UpperCase(name[1])[1]; 40 | If FileExists(name + ext) Then exit(name + ext); 41 | End; 42 | End; 43 | 44 | End. 45 | 46 | -------------------------------------------------------------------------------- /src/units/m_random.pas: -------------------------------------------------------------------------------- 1 | Unit m_random; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | ; 10 | 11 | // Returns a number from 0 to 255, 12 | // from a lookup table. 13 | Function M_Random(): int; 14 | 15 | // As M_Random, but used only by the play simulation. 16 | Function P_Random(): int; 17 | 18 | // [crispy] our own private random function 19 | Function Crispy_Random(): int; 20 | 21 | // Fix randoms for demos. 22 | Procedure M_ClearRandom(); 23 | 24 | // Defined version of P_Random() - P_Random() 25 | Function P_SubRandom(): int; 26 | Function Crispy_SubRandom(): int; 27 | 28 | Implementation 29 | 30 | Const 31 | 32 | rndtable: Array[0..255] Of uint8 = ( 33 | 0, 8, 109, 220, 222, 241, 149, 107, 75, 248, 254, 140, 16, 66, 34 | 74, 21, 211, 47, 80, 242, 154, 27, 205, 128, 161, 89, 77, 36, 35 | 95, 110, 85, 48, 212, 140, 211, 249, 22, 79, 200, 50, 28, 188, 36 | 52, 140, 202, 120, 68, 145, 62, 70, 184, 190, 91, 197, 152, 224, 37 | 149, 104, 25, 178, 252, 182, 202, 182, 141, 197, 4, 81, 181, 242, 38 | 145, 42, 39, 227, 156, 198, 225, 193, 219, 93, 122, 175, 249, 0, 39 | 175, 143, 70, 239, 46, 246, 163, 53, 163, 109, 168, 135, 2, 235, 40 | 25, 92, 20, 145, 138, 77, 69, 166, 78, 176, 173, 212, 166, 113, 41 | 94, 161, 41, 50, 239, 49, 111, 164, 70, 60, 2, 37, 171, 75, 42 | 136, 156, 11, 56, 42, 146, 138, 229, 73, 146, 77, 61, 98, 196, 43 | 135, 106, 63, 197, 195, 86, 96, 203, 113, 101, 170, 247, 181, 113, 44 | 80, 250, 108, 7, 255, 237, 129, 226, 79, 107, 112, 166, 103, 241, 45 | 24, 223, 239, 120, 198, 58, 60, 82, 128, 3, 184, 66, 143, 224, 46 | 145, 224, 81, 206, 163, 45, 63, 90, 168, 114, 59, 33, 159, 95, 47 | 28, 139, 123, 98, 125, 196, 15, 70, 194, 253, 54, 14, 109, 226, 48 | 71, 17, 161, 93, 186, 87, 244, 138, 20, 52, 123, 251, 26, 36, 49 | 17, 46, 52, 231, 232, 76, 31, 221, 84, 37, 216, 165, 212, 106, 50 | 197, 242, 98, 43, 39, 175, 254, 145, 190, 84, 118, 222, 187, 136, 51 | 120, 163, 236, 249 52 | ); 53 | 54 | Var 55 | rndindex: int = 0; 56 | prndindex: int = 0; 57 | crndindex: int = 0; 58 | 59 | Function M_Random(): int; 60 | Begin 61 | rndindex := (rndindex + 1) And $FF; 62 | result := rndtable[rndindex]; 63 | End; 64 | 65 | Function P_Random(): int; 66 | Begin 67 | prndindex := (prndindex + 1) And $FF; 68 | result := rndtable[prndindex]; 69 | End; 70 | 71 | Function Crispy_Random(): int; 72 | Begin 73 | crndindex := (crndindex + 1) And $FF; 74 | result := rndtable[crndindex]; 75 | End; 76 | 77 | Procedure M_ClearRandom(); 78 | Begin 79 | rndindex := 0; 80 | prndindex := 0; 81 | crndindex := 0; 82 | End; 83 | 84 | Function P_SubRandom(): int; 85 | Var 86 | r: int; 87 | Begin 88 | r := P_Random(); 89 | result := r - P_Random(); 90 | End; 91 | 92 | Function Crispy_SubRandom(): int; 93 | Var 94 | r: int; 95 | Begin 96 | r := Crispy_Random(); 97 | result := r - Crispy_Random(); 98 | End; 99 | 100 | End. 101 | 102 | -------------------------------------------------------------------------------- /src/units/net_client.pas: -------------------------------------------------------------------------------- 1 | Unit net_client; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | Classes, SysUtils; 9 | 10 | Var 11 | // true if the client code is in use 12 | net_client_connected: Boolean = false; 13 | 14 | // Connected but not participating in the game (observer) 15 | drone: boolean = false; 16 | 17 | Implementation 18 | 19 | End. 20 | 21 | -------------------------------------------------------------------------------- /src/units/net_defs.pas: -------------------------------------------------------------------------------- 1 | Unit net_defs; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , d_mode 10 | ; 11 | 12 | Const 13 | // The maximum number of players, multiplayer/networking. 14 | // This is the maximum supported by the networking code; individual games 15 | // have their own values for MAXPLAYERS that can be smaller. 16 | 17 | NET_MAXPLAYERS = 8; 18 | 19 | // Networking and tick handling related. 20 | 21 | BACKUPTICS = 128; 22 | 23 | // Game settings sent by client to server when initiating game start, 24 | // and received from the server by clients when the game starts. 25 | 26 | Type 27 | net_gamesettings_t = Record 28 | ticdup: int; 29 | extratics: int; 30 | deathmatch: int; 31 | episode: int; 32 | nomonsters: boolean; 33 | fast_monsters: boolean; 34 | respawn_monsters: boolean; 35 | map: int; 36 | skill: skill_t; 37 | gameversion: GameVersion_t; 38 | lowres_turn: boolean; 39 | new_sync: int; 40 | timelimit: int; 41 | loadgame: int; 42 | random: int; // [Strife only] 43 | 44 | // These fields are only used by the server when sending a game 45 | // start message: 46 | 47 | num_players: int; 48 | consoleplayer: int; 49 | 50 | // Hexen player classes: 51 | 52 | player_classes: Array[0..NET_MAXPLAYERS - 1] Of int; 53 | End; 54 | 55 | Implementation 56 | 57 | End. 58 | 59 | -------------------------------------------------------------------------------- /src/units/p_bexptr.pas: -------------------------------------------------------------------------------- 1 | Unit p_bexptr; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , info_types 10 | ; 11 | 12 | Procedure A_Die(actor: Pmobj_t); 13 | Procedure A_BetaSkullAttack(actor: Pmobj_t); 14 | Procedure A_Detonate(mo: Pmobj_t); 15 | 16 | Procedure A_Stop(actor: Pmobj_t); 17 | Procedure A_Mushroom(actor: Pmobj_t); 18 | 19 | Procedure A_FireOldBFG(mobj: Pmobj_t; player: Pplayer_t; psp: Ppspdef_t); 20 | Procedure A_RandomJump(mobj: Pmobj_t; player: Pplayer_t; psp: Ppspdef_t); 21 | 22 | Implementation 23 | 24 | Uses 25 | sounds 26 | , m_random, m_fixed 27 | , p_map, p_inter, p_enemy, p_maputl, p_mobj 28 | , s_sound 29 | ; 30 | 31 | // killough 11/98: kill an object 32 | 33 | Procedure A_Die(actor: Pmobj_t); 34 | Begin 35 | P_DamageMobj(actor, Nil, Nil, actor^.health); 36 | End; 37 | 38 | // 39 | // A_BetaSkullAttack() 40 | // killough 10/98: this emulates the beta version's lost soul attacks 41 | // 42 | 43 | Procedure A_BetaSkullAttack(actor: Pmobj_t); 44 | Var 45 | damage: int; 46 | Begin 47 | If (actor^.target = Nil) Or (actor^.target^._type = MT_SKULL) Then exit; 48 | 49 | S_StartSound(actor, actor^.info^.attacksound); 50 | A_FaceTarget(actor); 51 | damage := (P_Random((* pr_skullfly *)) Mod 8 + 1) * actor^.info^.damage; 52 | P_DamageMobj(actor^.target, actor, actor, damage); 53 | End; 54 | 55 | // 56 | // A_Detonate 57 | // killough 8/9/98: same as A_Explode, except that the damage is variable 58 | // 59 | 60 | Procedure A_Detonate(mo: Pmobj_t); 61 | Begin 62 | P_RadiusAttack(mo, mo^.target, mo^.info^.damage); 63 | End; 64 | 65 | Procedure A_Stop(actor: Pmobj_t); 66 | Begin 67 | actor^.momx := 0; 68 | actor^.momy := 0; 69 | actor^.momz := 0; 70 | End; 71 | 72 | // 73 | // killough 9/98: a mushroom explosion effect, sorta :) 74 | // Original idea: Linguica 75 | // 76 | 77 | Procedure A_Mushroom(actor: Pmobj_t); 78 | Var 79 | i, j, n: int; 80 | misc1, misc2: fixed_t; 81 | target, mo: Pmobj_t; 82 | Begin 83 | n := actor^.info^.damage; 84 | 85 | // Mushroom parameters are part of code pointer's state 86 | If actor^.state^.misc1 <> 0 Then Begin 87 | misc1 := actor^.state^.misc1; 88 | End 89 | Else Begin 90 | misc1 := FRACUNIT * 4; 91 | End; 92 | If actor^.state^.misc2 <> 0 Then Begin 93 | misc2 := actor^.state^.misc2; 94 | End 95 | Else Begin 96 | misc2 := FRACUNIT Div 2; 97 | End; 98 | 99 | A_Explode(actor); // make normal explosion 100 | 101 | // for (i = -n; i <= n; i += 8) 102 | i := -n; 103 | While i <= n Do Begin // launch mushroom cloud 104 | // for (j = -n; j <= n; j += 8) 105 | j := -n; 106 | While j <= n Do Begin 107 | target := actor; 108 | target^.x := target^.x + i Shl FRACBITS; // Aim in many directions from source 109 | target^.y := target^.y + j Shl FRACBITS; 110 | target^.z := target^.z + P_AproxDistance(i, j) * misc1; // Aim fairly high 111 | mo := P_SpawnMissile(actor, target, MT_FATSHOT); // Launch fireball 112 | mo^.momx := FixedMul(mo^.momx, misc2); 113 | mo^.momy := FixedMul(mo^.momy, misc2); // Slow down a bit 114 | mo^.momz := FixedMul(mo^.momz, misc2); 115 | mo^.flags := mo^.flags And Not MF_NOGRAVITY; // Make debris fall under gravity 116 | j := j + 8; 117 | End; 118 | i := i + 8; 119 | End; 120 | End; 121 | 122 | // 123 | // A_FireOldBFG 124 | // 125 | // This function emulates Doom's Pre-Beta BFG 126 | // By Lee Killough 6/6/98, 7/11/98, 7/19/98, 8/20/98 127 | // 128 | // This code may not be used in other mods without appropriate credit given. 129 | // Code leeches will be telefragged. 130 | 131 | Procedure A_FireOldBFG(mobj: Pmobj_t; player: Pplayer_t; psp: Ppspdef_t); 132 | Begin 133 | Raise Exception.Create('Port me.'); 134 | 135 | // int type = MT_PLASMA1; 136 | // extern void P_CheckMissileSpawn (mobj_t* th); 137 | // 138 | // if (!player) return; // [crispy] let pspr action pointers get called from mobj states 139 | // 140 | // player->ammo[weaponinfo[player->readyweapon].ammo]--; 141 | // 142 | // player->extralight = 2; 143 | // 144 | // do 145 | // { 146 | // mobj_t *th, *mo = player->mo; 147 | // angle_t an = mo->angle; 148 | // angle_t an1 = ((P_Random(/* pr_bfg */)&127) - 64) * (ANG90/768) + an; 149 | // angle_t an2 = ((P_Random(/* pr_bfg */)&127) - 64) * (ANG90/640) + ANG90; 150 | //// extern int autoaim; 151 | // 152 | //// if (autoaim || !beta_emulation) 153 | // { 154 | // // killough 8/2/98: make autoaiming prefer enemies 155 | // int mask = 0;//MF_FRIEND; 156 | // fixed_t slope; 157 | // if (critical->freeaim == FREEAIM_DIRECT) 158 | // slope = PLAYER_SLOPE(player); 159 | // else 160 | // do 161 | // { 162 | // slope = P_AimLineAttack(mo, an, 16*64*FRACUNIT);//, mask); 163 | // if (!linetarget) 164 | // slope = P_AimLineAttack(mo, an += 1<<26, 16*64*FRACUNIT);//, mask); 165 | // if (!linetarget) 166 | // slope = P_AimLineAttack(mo, an -= 2<<26, 16*64*FRACUNIT);//, mask); 167 | // if (!linetarget) 168 | // slope = (critical->freeaim == FREEAIM_BOTH) ? PLAYER_SLOPE(player) : 0, an = mo->angle; 169 | // } 170 | // while (mask && (mask=0, !linetarget)); // killough 8/2/98 171 | // an1 += an - mo->angle; 172 | // // [crispy] consider negative slope 173 | // if (slope < 0) 174 | // an2 -= tantoangle[-slope >> DBITS]; 175 | // else 176 | // an2 += tantoangle[slope >> DBITS]; 177 | // } 178 | // 179 | // th = P_SpawnMobj(mo->x, mo->y, 180 | // mo->z + 62*FRACUNIT - player->psprites[ps_weapon].sy, 181 | // type); 182 | // // [NS] Play projectile sound. 183 | // if (th->info->seesound) 184 | // { 185 | // S_StartSound (th, th->info->seesound); 186 | // } 187 | // th->target = mo; // P_SetTarget(&th->target, mo); 188 | // th->angle = an1; 189 | // // [NS] Use speed from thing info. 190 | // th->momx = FixedMul(th->info->speed, finecosine[an1>>ANGLETOFINESHIFT]); 191 | // th->momy = FixedMul(th->info->speed, finesine[an1>>ANGLETOFINESHIFT]); 192 | // th->momz = FixedMul(th->info->speed, finetangent[an2>>ANGLETOFINESHIFT]); 193 | // // [crispy] suppress interpolation of player missiles for the first tic 194 | // th->interp = -1; 195 | // P_CheckMissileSpawn(th); 196 | // } 197 | // while ((type != MT_PLASMA2) && (type = MT_PLASMA2)); //killough: obfuscated! 198 | 199 | End; 200 | 201 | Procedure A_RandomJump(mobj: Pmobj_t; player: Pplayer_t; psp: Ppspdef_t); 202 | Begin 203 | Raise exception.create('Port me.'); 204 | End; 205 | 206 | End. 207 | 208 | -------------------------------------------------------------------------------- /src/units/p_blockmap.pas: -------------------------------------------------------------------------------- 1 | Unit p_blockmap; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Procedure P_CreateBlockMap(); 11 | 12 | Implementation 13 | 14 | Procedure P_CreateBlockMap(); 15 | Begin 16 | Raise exception.create('Fehlende Portierung: P_CreateBlockMap'); 17 | End; 18 | 19 | End. 20 | 21 | -------------------------------------------------------------------------------- /src/units/p_extnodes.pas: -------------------------------------------------------------------------------- 1 | Unit p_extnodes; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Type 11 | mapformat_t = 12 | ( 13 | MFMT_DOOMBSP = $000, 14 | MFMT_DEEPBSP = $001, 15 | MFMT_ZDBSPX = $002, 16 | MFMT_ZDBSPZ = $004, 17 | MFMT_HEXEN = $100 18 | ); 19 | 20 | Function P_CheckMapFormat(lumpnum: int): mapformat_t; 21 | // 22 | //extern void P_LoadSegs_DeePBSP (int lump); 23 | //extern void P_LoadSubsectors_DeePBSP (int lump); 24 | //extern void P_LoadNodes_DeePBSP (int lump); 25 | //extern void P_LoadNodes_ZDBSP (int lump, boolean compressed); 26 | //extern void P_LoadThings_Hexen (int lump); 27 | //extern void P_LoadLineDefs_Hexen (int lump); 28 | 29 | Implementation 30 | 31 | Uses 32 | doomdata 33 | , w_wad 34 | , z_zone 35 | ; 36 | 37 | Function memcmp(Const data: Array Of Byte; Str: String): Boolean; 38 | Var 39 | i: Integer; 40 | Begin 41 | result := true; 42 | For i := 1 To Length(str) Do Begin 43 | If ord(str[i]) <> data[i - 1] Then Begin 44 | result := false; 45 | break; 46 | End; 47 | End; 48 | End; 49 | 50 | // [crispy] support maps with NODES in compressed or uncompressed ZDBSP 51 | // format or DeePBSP format and/or LINEDEFS and THINGS lumps in Hexen format 52 | 53 | Function P_CheckMapFormat(lumpnum: INT): mapformat_t; 54 | Var 55 | _format: mapformat_t; 56 | nodes: Array Of Byte; 57 | b: int; 58 | Begin 59 | _format := MFMT_DOOMBSP; 60 | b := lumpnum + ML_BLOCKMAP + 1; 61 | If (b < length(lumpinfo)) And (lumpinfo[b].name = 'BEHAVIOR') Then Begin 62 | write(stderr, 'Hexen ('); 63 | _format := MFMT_HEXEN; 64 | End 65 | Else 66 | write(stderr, 'Doom ('); 67 | b := lumpnum + ML_NODES; 68 | nodes := W_CacheLumpNum(b, PU_CACHE); 69 | If (Not (b < length(lumpinfo)) And ( 70 | (assigned(nodes))) And ( 71 | W_LumpLength(b) > 0)) Then 72 | write(stderr, 'no nodes') 73 | Else Begin 74 | If (memcmp(nodes, 'xNd4'#0#0#0#0)) 75 | Then Begin 76 | write(stderr, 'DeePBSP'); 77 | _format := MFMT_DEEPBSP; 78 | End 79 | Else Begin 80 | If (memcmp(nodes, 'XNOD')) Then Begin 81 | write(stderr, 'ZDBSP'); 82 | _format := MFMT_ZDBSPX; 83 | End 84 | Else Begin 85 | If (memcmp(nodes, 'ZNOD')) Then Begin 86 | write(stderr, 'compressed ZDBSP'); 87 | _format := MFMT_ZDBSPZ; 88 | End 89 | Else 90 | write(stderr, 'BSP'); 91 | End; 92 | End; 93 | End; 94 | 95 | // if (nodes) 96 | // W_ReleaseLumpNum(b); 97 | 98 | RESULT := _format; 99 | End; 100 | 101 | End. 102 | 103 | -------------------------------------------------------------------------------- /src/units/p_local.pas: -------------------------------------------------------------------------------- 1 | Unit p_local; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , info_types 10 | , m_fixed 11 | ; 12 | Const 13 | // [crispy] blinking key or skull in the status bar 14 | KEYBLINKMASK = $8; 15 | KEYBLINKTICS = (7 * KEYBLINKMASK); 16 | 17 | TOCENTER = -8; 18 | AFLAG_JUMP = $80; 19 | FLOATSPEED = (FRACUNIT * 4); 20 | 21 | MAXHEALTH = 100; 22 | DEFINE_VIEWHEIGHT = (41 * FRACUNIT); 23 | 24 | // mapblocks are used to check movement 25 | // against lines and things 26 | MAPBLOCKUNITS = 128; 27 | MAPBLOCKSIZE = (MAPBLOCKUNITS * FRACUNIT); 28 | MAPBLOCKSHIFT = (FRACBITS + 7); 29 | MAPBMASK = (MAPBLOCKSIZE - 1); 30 | MAPBTOFRAC = (MAPBLOCKSHIFT - FRACBITS); 31 | 32 | 33 | // player radius for movement checking 34 | PLAYERRADIUS = 16 * FRACUNIT; 35 | 36 | // MAXRADIUS is for precalculated sector block boxes 37 | // the spider demon is larger, 38 | // but we do not have any moving sectors nearby 39 | MAXRADIUS = 32 * FRACUNIT; 40 | 41 | GRAVITY = FRACUNIT; 42 | MAXMOVE = (30 * FRACUNIT); 43 | 44 | USERANGE = (64 * FRACUNIT); 45 | MELEERANGE = (64 * FRACUNIT); 46 | MISSILERANGE = (32 * 64 * FRACUNIT); 47 | 48 | // follow a player exlusively for 3 seconds 49 | BASETHRESHOLD = 100; 50 | 51 | // fraggle: I have increased the size of this buffer. In the original Doom, 52 | // overrunning past this limit caused other bits of memory to be overwritten, 53 | // affecting demo playback. However, in doing so, the limit was still 54 | // exceeded. So we have to support more than 8 specials. 55 | // 56 | // We keep the original limit, to detect what variables in memory were 57 | // overwritten (see SpechitOverrun()) 58 | MAXSPECIALCROSS = 20; 59 | MAXSPECIALCROSS_ORIGINAL = 8; 60 | 61 | // 62 | // P_TICK 63 | // 64 | 65 | // both the head and tail of the thinker list 66 | //extern thinker_t thinkercap; 67 | 68 | 69 | //void P_InitThinkers (void); 70 | //void P_AddThinker (thinker_t* thinker); 71 | //void P_RemoveThinker (thinker_t* thinker); 72 | 73 | 74 | // 75 | // P_PSPR 76 | // 77 | //void P_SetupPsprites (player_t* curplayer); 78 | //void P_MovePsprites (player_t* curplayer); 79 | //void P_DropWeapon (player_t* player); 80 | 81 | 82 | // 83 | // P_USER 84 | // 85 | Const 86 | MLOOKUNIT = 8; 87 | 88 | // 89 | // P_MOBJ 90 | // 91 | ONFLOORZ = INT_MIN; 92 | ONCEILINGZ = INT_MAX; 93 | 94 | // Time interval for item respawning. 95 | ITEMQUESIZE = 128; 96 | 97 | Type 98 | // 99 | // P_MAPUTL 100 | // 101 | divline_t = Record 102 | x: fixed_t; 103 | y: fixed_t; 104 | dx: fixed_t; 105 | dy: fixed_t; 106 | End; 107 | Pdivline_t = ^divline_t; 108 | 109 | dt = Record 110 | Case boolean Of 111 | true: (thing: pmobj_t); 112 | false: (line: pline_t); 113 | End; 114 | 115 | intercept_t = Record 116 | frac: fixed_t; // along trace line 117 | isaline: boolean; 118 | d: dt; 119 | End; 120 | 121 | Pintercept_t = ^intercept_t; 122 | 123 | traverser_t = Function(_in: Pintercept_t): Boolean; 124 | 125 | //// Extended MAXINTERCEPTS, to allow for intercepts overrun emulation. 126 | // 127 | Const 128 | MAXINTERCEPTS_ORIGINAL = 128; 129 | //#define MAXINTERCEPTS (MAXINTERCEPTS_ORIGINAL + 61) 130 | // 131 | ////extern intercept_t intercepts[MAXINTERCEPTS]; // [crispy] remove INTERCEPTS limit 132 | //extern intercept_t* intercept_p; 133 | // 134 | //typedef boolean (*traverser_t) (intercept_t *in); 135 | // 136 | //fixed_t P_AproxDistance (fixed_t dx, fixed_t dy); 137 | //int P_PointOnLineSide (fixed_t x, fixed_t y, line_t* line); 138 | //int P_PointOnDivlineSide (fixed_t x, fixed_t y, divline_t* line); 139 | //void P_MakeDivline (line_t* li, divline_t* dl); 140 | //fixed_t P_InterceptVector (divline_t* v2, divline_t* v1); 141 | //int P_BoxOnLineSide (fixed_t* tmbox, line_t* ld); 142 | // 143 | //extern fixed_t opentop; 144 | //extern fixed_t openbottom; 145 | //extern fixed_t openrange; 146 | //extern fixed_t lowfloor; 147 | // 148 | //void P_LineOpening (line_t* linedef); 149 | // 150 | //boolean P_BlockLinesIterator (int x, int y, boolean(*func)(line_t*) ); 151 | //boolean P_BlockThingsIterator (int x, int y, boolean(*func)(mobj_t*) ); 152 | 153 | Const 154 | PT_ADDLINES = 1; 155 | PT_ADDTHINGS = 2; 156 | PT_EARLYOUT = 4; 157 | 158 | //extern divline_t trace; 159 | // 160 | //boolean 161 | //P_PathTraverse 162 | //( fixed_t x1, 163 | // fixed_t y1, 164 | // fixed_t x2, 165 | // fixed_t y2, 166 | // int flags, 167 | // boolean (*trav) (intercept_t *)); 168 | // 169 | //void P_UnsetThingPosition (mobj_t* thing); 170 | //void P_SetThingPosition (mobj_t* thing); 171 | // 172 | // 173 | //// 174 | //// P_MAP 175 | //// 176 | // 177 | //// If "floatok" true, move would be ok 178 | //// if within "tmfloorz - tmceilingz". 179 | //extern boolean floatok; 180 | //extern fixed_t tmfloorz; 181 | //extern fixed_t tmceilingz; 182 | // 183 | // 184 | //extern line_t* ceilingline; 185 | // 186 | //// fraggle: I have increased the size of this buffer. In the original Doom, 187 | //// overrunning past this limit caused other bits of memory to be overwritten, 188 | //// affecting demo playback. However, in doing so, the limit was still 189 | //// exceeded. So we have to support more than 8 specials. 190 | //// 191 | //// We keep the original limit, to detect what variables in memory were 192 | //// overwritten (see SpechitOverrun()) 193 | // 194 | //#define MAXSPECIALCROSS 20 195 | //#define MAXSPECIALCROSS_ORIGINAL 8 196 | // 197 | //extern line_t** spechit; // [crispy] remove SPECHIT limit 198 | //extern int numspechit; 199 | // 200 | //boolean P_CheckPosition (mobj_t *thing, fixed_t x, fixed_t y); 201 | //boolean P_TryMove (mobj_t* thing, fixed_t x, fixed_t y); 202 | //boolean P_TeleportMove (mobj_t* thing, fixed_t x, fixed_t y); 203 | //void P_SlideMove (mobj_t* mo); 204 | //boolean P_CheckSight (mobj_t* t1, mobj_t* t2); 205 | //void P_UseLines (player_t* player); 206 | // 207 | //boolean P_ChangeSector (sector_t* sector, boolean crunch); 208 | // 209 | //extern mobj_t* linetarget; // who got hit (or NULL) 210 | // 211 | // 212 | //extern fixed_t attackrange; 213 | // 214 | //// slopes to top and bottom of target 215 | //extern fixed_t topslope; 216 | //extern fixed_t bottomslope; 217 | 218 | //fixed_t 219 | //P_AimLineAttack 220 | //( mobj_t* t1, 221 | // angle_t angle, 222 | // fixed_t distance ); 223 | 224 | //void 225 | //P_RadiusAttack 226 | //( mobj_t* spot, 227 | // mobj_t* source, 228 | // int damage ); 229 | 230 | //// 231 | //// P_SETUP 232 | //// 233 | //extern byte* rejectmatrix; // for fast sight rejection 234 | //extern int32_t* blockmaplump; // offsets in blockmap are from here // [crispy] BLOCKMAP limit 235 | //extern int32_t* blockmap; // [crispy] BLOCKMAP limit 236 | //extern int bmapwidth; 237 | //extern int bmapheight; // in mapblocks 238 | //extern fixed_t bmaporgx; 239 | //extern fixed_t bmaporgy; // origin of block map 240 | //extern mobj_t** blocklinks; // for thing chains 241 | // 242 | //// [crispy] factor out map lump name and number finding into a separate function 243 | //extern int P_GetNumForMap (int episode, int map, boolean critical); 244 | 245 | //extern int st_keyorskull[3]; 246 | // 247 | //// 248 | //// P_INTER 249 | //// 250 | //extern int maxammo[NUMAMMO]; 251 | //extern int clipammo[NUMAMMO]; 252 | // 253 | //void 254 | //P_TouchSpecialThing 255 | //( mobj_t* special, 256 | // mobj_t* toucher ); 257 | // 258 | //void 259 | //P_DamageMobj 260 | //( mobj_t* target, 261 | // mobj_t* inflictor, 262 | // mobj_t* source, 263 | // int damage ); 264 | 265 | Function PLAYER_SLOPE(a: pplayer_t): fixed_t; 266 | 267 | Implementation 268 | 269 | Function PLAYER_SLOPE(a: pplayer_t): fixed_t; 270 | Begin 271 | result := SarLongint(a^.lookdir Div MLOOKUNIT, FRACBITS) Div 173; 272 | End; 273 | 274 | End. 275 | 276 | -------------------------------------------------------------------------------- /src/units/p_saveg.pas: -------------------------------------------------------------------------------- 1 | Unit p_saveg; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Var 11 | savegame_error: boolean; 12 | 13 | Function P_SaveGameFile(slot: int): String; 14 | Function P_TempSaveGameFile(): String; 15 | Procedure P_WriteSaveGameHeader(Const Stream: TStream; description: String); 16 | 17 | Procedure P_ArchivePlayers(Const Stream: TStream); 18 | 19 | Implementation 20 | 21 | Uses 22 | dstrings, doomdef, info_types 23 | , d_main 24 | , g_game 25 | , m_menu 26 | , p_tick 27 | ; 28 | 29 | Procedure saveg_write_pad(); 30 | Begin 31 | // Nichts, wer braucht das .. 32 | End; 33 | 34 | // Get the filename of the save game file to use for the specified slot. 35 | 36 | Function P_SaveGameFile(slot: int): String; 37 | Var 38 | filename, basename: String; 39 | Begin 40 | basename := SAVEGAMENAME + format('%d.dsg', [10 * savepage + slot]); 41 | filename := savegamedir + basename; 42 | result := filename; 43 | End; 44 | 45 | Function P_TempSaveGameFile(): String; 46 | Const 47 | filename: String = ''; 48 | Begin 49 | If (filename = '') Then Begin 50 | filename := savegamedir + 'temp.dsg'; 51 | End; 52 | result := filename; 53 | End; 54 | 55 | Procedure P_WriteSaveGameHeader(Const Stream: TStream; description: String); 56 | Var 57 | name: String; 58 | i: Integer; 59 | Begin 60 | stream.WriteAnsiString(description); 61 | name := format('version %d', [G_VanillaVersionCode()]); 62 | stream.WriteAnsiString(name); 63 | stream.Write(gameskill, sizeof(gameskill)); 64 | stream.Write(gameepisode, sizeof(gameepisode)); 65 | stream.Write(gamemap, sizeof(gamemap)); 66 | For i := 0 To MAXPLAYERS - 1 Do 67 | stream.Write(playeringame[i], sizeof(playeringame[i])); 68 | stream.Write(leveltime, sizeof(leveltime)); 69 | End; 70 | 71 | Procedure saveg_write_player_t(Const Stream: TStream; Const str: player_t); 72 | Var 73 | i: int; 74 | Begin 75 | // mobj_t* mo; 76 | // saveg_writep(str.mo); 77 | 78 | // playerstate_t playerstate; 79 | stream.Write(str.playerstate, sizeof(str.playerstate)); 80 | 81 | // ticcmd_t cmd; 82 | stream.Write(str.cmd, sizeof(str.cmd)); 83 | 84 | // fixed_t viewz; 85 | stream.Write(str.viewz, sizeof(str.viewz)); 86 | 87 | // fixed_t viewheight; 88 | stream.Write(str.viewheight, sizeof(str.viewheight)); 89 | 90 | // fixed_t deltaviewheight; 91 | stream.Write(str.deltaviewheight, sizeof(str.deltaviewheight)); 92 | 93 | // fixed_t bob; 94 | stream.Write(str.bob, sizeof(str.bob)); 95 | 96 | // int health; 97 | stream.Write(str.health, sizeof(str.health)); 98 | 99 | // int armorpoints; 100 | stream.Write(str.armorpoints, sizeof(str.armorpoints)); 101 | 102 | // int armortype; 103 | stream.Write(str.armortype, sizeof(str.armortype)); 104 | 105 | // int powers[NUMPOWERS]; 106 | For i := 0 To int(NUMPOWERS) - 1 Do Begin 107 | stream.Write(str.powers[i], sizeof(str.powers[i])); 108 | End; 109 | 110 | // boolean cards[NUMCARDS]; 111 | For i := 0 To int(NUMCARDS) - 1 Do Begin 112 | stream.Write(str.cards[card_t(i)], sizeof(str.cards[card_t(i)])); 113 | End; 114 | 115 | // boolean backpack; 116 | stream.Write(str.backpack, sizeof(str.backpack)); 117 | 118 | // int frags[MAXPLAYERS]; 119 | For i := 0 To MAXPLAYERS - 1 Do Begin 120 | stream.Write(str.frags[i], sizeof(str.frags[i])); 121 | End; 122 | 123 | // weapontype_t readyweapon; 124 | stream.Write(str.readyweapon, sizeof(str.readyweapon)); 125 | 126 | // weapontype_t pendingweapon; 127 | stream.Write(str.pendingweapon, sizeof(str.pendingweapon)); 128 | 129 | // boolean weaponowned[NUMWEAPONS]; 130 | For i := 0 To int(NUMWEAPONS) - 1 Do 131 | stream.Write(str.weaponowned[weapontype_t(i)], sizeof(str.weaponowned[weapontype_t(i)])); 132 | 133 | // int ammo[NUMAMMO]; 134 | For i := 0 To int(NUMAMMO) - 1 Do 135 | stream.Write(str.ammo[i], sizeof(str.ammo[i])); 136 | 137 | // int maxammo[NUMAMMO]; 138 | For i := 0 To int(NUMAMMO) - 1 Do 139 | stream.Write(str.maxammo[i], sizeof(str.maxammo[i])); 140 | 141 | // int attackdown; 142 | stream.Write(str.attackdown, sizeof(str.attackdown)); 143 | // int usedown; 144 | stream.Write(str.usedown, sizeof(str.usedown)); 145 | // int cheats; 146 | stream.Write(str.cheats, sizeof(str.cheats)); 147 | 148 | // int refire; 149 | stream.Write(str.refire, sizeof(str.refire)); 150 | 151 | // int killcount; 152 | stream.Write(str.killcount, sizeof(str.killcount)); 153 | 154 | // int itemcount; 155 | stream.Write(str.itemcount, sizeof(str.itemcount)); 156 | 157 | // int secretcount; 158 | stream.Write(str.secretcount, sizeof(str.secretcount)); 159 | 160 | // char* message; 161 | stream.WriteAnsiString(str.message); 162 | 163 | // int damagecount; 164 | stream.Write(str.damagecount, sizeof(str.damagecount)); 165 | 166 | // int bonuscount; 167 | stream.Write(str.bonuscount, sizeof(str.bonuscount)); 168 | 169 | // mobj_t* attacker; 170 | // stream.Write(str.attacker, sizeof(str.attacker)); --> Das geht so nicht .. 171 | 172 | // int extralight; 173 | stream.Write(str.extralight, sizeof(str.extralight)); 174 | 175 | // int fixedcolormap; 176 | stream.Write(str.fixedcolormap, sizeof(str.fixedcolormap)); 177 | 178 | // int colormap; 179 | stream.Write(str.colormap, sizeof(str.colormap)); 180 | 181 | 182 | // pspdef_t psprites[NUMPSPRITES]; 183 | For i := 0 To int(NUMSPRITES) - 1 Do Begin 184 | // stream.Write(str.psprites[i], sizeof(str.psprites[i])); --> Das geht so nicht.. 185 | End; 186 | 187 | // boolean didsecret; 188 | stream.Write(str.didsecret, sizeof(str.didsecret)); 189 | End; 190 | 191 | Procedure P_ArchivePlayers(Const Stream: TStream); 192 | Var 193 | i: int; 194 | Begin 195 | For i := 0 To MAXPLAYERS - 1 Do Begin 196 | 197 | If (Not playeringame[i]) Then 198 | continue; 199 | 200 | saveg_write_pad(); 201 | 202 | saveg_write_player_t(stream, players[i]); 203 | 204 | 205 | End; 206 | End; 207 | 208 | End. 209 | 210 | -------------------------------------------------------------------------------- /src/units/p_telept.pas: -------------------------------------------------------------------------------- 1 | Unit p_telept; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , info_types 10 | ; 11 | 12 | Function EV_Teleport(line: Pline_t; side: int; thing: Pmobj_t): int; 13 | 14 | Implementation 15 | 16 | Uses 17 | doomstat, sounds, tables 18 | , d_mode 19 | , p_mobj, p_setup, p_tick, p_map 20 | , s_sound 21 | ; 22 | 23 | // 24 | // TELEPORTATION 25 | // 26 | 27 | Function EV_Teleport(line: Pline_t; side: int; thing: Pmobj_t): int; 28 | Var 29 | i, tag: int; 30 | m, fog: pmobj_t; 31 | an: unsigned; 32 | thinker: Pthinker_t; 33 | sector: Psector_t; 34 | oldx, oldy, oldz: fixed_t; 35 | Begin 36 | 37 | // don't teleport missiles 38 | If (thing^.flags And MF_MISSILE) <> 0 Then Begin 39 | result := 0; 40 | exit; 41 | End; 42 | 43 | // Don't teleport if hit back of line, 44 | // so you can get out of teleporter. 45 | If (side = 1) Then Begin 46 | result := 0; 47 | exit; 48 | End; 49 | 50 | 51 | tag := line^.tag; 52 | 53 | For i := 0 To numsectors - 1 Do Begin 54 | 55 | If (sectors[i].tag = tag) Then Begin 56 | 57 | thinker := thinkercap.next; 58 | While thinker <> @thinkercap Do Begin 59 | // for (thinker = thinkercap.next; 60 | // thinker != &thinkercap; 61 | // thinker = thinker->next) 62 | // not a mobj 63 | If (thinker^._function.acp1 <> @P_MobjThinker) Then Begin 64 | thinker := thinker^.next; 65 | continue; 66 | End; 67 | 68 | m := pmobj_t(thinker); 69 | 70 | // not a teleportman 71 | If (m^._type <> MT_TELEPORTMAN) Then Begin 72 | thinker := thinker^.next; 73 | continue; 74 | End; 75 | 76 | sector := m^.subsector^.sector; 77 | // wrong sector 78 | If ((sector - @sectors[0]) Div SizeOf(sectors[0]) <> i) Then Begin 79 | thinker := thinker^.next; 80 | continue; 81 | End; 82 | oldx := thing^.x; 83 | oldy := thing^.y; 84 | oldz := thing^.z; 85 | 86 | If (Not P_TeleportMove(thing, m^.x, m^.y)) Then Begin 87 | result := 0; 88 | exit; 89 | End; 90 | 91 | // The first Final Doom executable does not set thing^.z 92 | // when teleporting. This quirk is unique to this 93 | // particular version; the later version included in 94 | // some versions of the Id Anthology fixed this. 95 | 96 | If (gameversion <> exe_final) Then 97 | thing^.z := thing^.floorz; 98 | 99 | If assigned(thing^.player) Then Begin 100 | 101 | thing^.player^.viewz := thing^.z + thing^.player^.viewheight; 102 | // [crispy] center view after teleporting 103 | thing^.player^.centering := true; 104 | End; 105 | 106 | // spawn teleport fog at source and destination 107 | fog := P_SpawnMobj(oldx, oldy, oldz, MT_TFOG); 108 | S_StartSound(fog, sfx_telept); 109 | an := m^.angle Shr ANGLETOFINESHIFT; 110 | fog := P_SpawnMobj(m^.x + 20 * finecosine[an], m^.y + 20 * finesine[an] 111 | , thing^.z, MT_TFOG); 112 | 113 | // emit sound, where? 114 | S_StartSound(fog, sfx_telept); 115 | 116 | // don't move for a bit 117 | If assigned(thing^.player) Then 118 | thing^.reactiontime := 18; 119 | thing^.angle := m^.angle; 120 | thing^.momx := 0; 121 | thing^.momy := 0; 122 | thing^.momz := 0; 123 | result := 1; 124 | exit; 125 | End; 126 | End; 127 | End; 128 | result := 0; 129 | End; 130 | 131 | End. 132 | 133 | -------------------------------------------------------------------------------- /src/units/p_tick.pas: -------------------------------------------------------------------------------- 1 | Unit p_tick; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils, 9 | info_types 10 | ; 11 | 12 | Var 13 | thinkercap: thinker_t; 14 | leveltime: int; // tics in game play for par 15 | 16 | Procedure P_InitThinkers(); 17 | 18 | Procedure P_AddThinker(thinker: Pthinker_t); 19 | 20 | Procedure P_Ticker(); 21 | 22 | Procedure P_RemoveThinker(thinker: Pthinker_t); 23 | 24 | Implementation 25 | 26 | Uses 27 | doomdef, doomdata, info, sounds, tables 28 | , g_game 29 | , i_timer, i_system 30 | , m_fixed, m_menu 31 | , p_user, p_spec, p_mobj, p_local 32 | , r_main 33 | , s_sound, s_musinfo 34 | ; 35 | 36 | Procedure P_InitThinkers(); 37 | Begin 38 | thinkercap.prev := @thinkercap; 39 | thinkercap.next := @thinkercap; 40 | End; 41 | 42 | // 43 | // P_AddThinker 44 | // Adds a new thinker at the end of the list. 45 | // 46 | 47 | Procedure P_AddThinker(thinker: Pthinker_t); 48 | Begin 49 | thinkercap.prev^.next := thinker; 50 | thinker^.next := @thinkercap; 51 | thinker^.prev := thinkercap.prev; 52 | thinkercap.prev := thinker; 53 | End; 54 | 55 | // 56 | // P_RunThinkers 57 | // 58 | 59 | Procedure P_RunThinkers(); 60 | Var 61 | nextthinker, currentthinker: ^thinker_t; 62 | Begin 63 | currentthinker := thinkercap.next; 64 | While (currentthinker <> @thinkercap) Do Begin 65 | 66 | If (currentthinker^._function.acv = Nil) Then Begin 67 | // time to remove it 68 | nextthinker := currentthinker^.next; 69 | currentthinker^.next^.prev := currentthinker^.prev; 70 | currentthinker^.prev^.next := currentthinker^.next; 71 | // Z_Free(currentthinker); -- Muss nicht freigegeben werden, da wir das via FreeAllocations machen ;) 72 | End 73 | Else Begin 74 | If assigned(currentthinker^._function.acp1) Then 75 | currentthinker^._function.acp1(Pmobj_t(currentthinker)); 76 | nextthinker := currentthinker^.next; 77 | End; 78 | currentthinker := nextthinker; 79 | End; 80 | // [crispy] support MUSINFO lump (dynamic music changing) 81 | T_MusInfo(); 82 | End; 83 | 84 | // 85 | // P_RespawnSpecials 86 | // 87 | 88 | Procedure P_RespawnSpecials(); 89 | Var 90 | x, y, z: fixed_t; 91 | 92 | ss: Psubsector_t; 93 | mo: Pmobj_t; 94 | mthing: pmapthing_t; 95 | 96 | i, j: int; 97 | Begin 98 | // only respawn items in deathmatch 99 | // AX: deathmatch 3 is a Crispy-specific change 100 | If (deathmatch <> 2) And (deathmatch <> 3) Then exit; 101 | 102 | 103 | // nothing left to respawn? 104 | If (iquehead = iquetail) Then exit; 105 | 106 | // wait at least 30 seconds 107 | If (leveltime - itemrespawntime[iquetail] < 30 * TICRATE) Then exit; 108 | 109 | mthing := @itemrespawnque[iquetail]; 110 | 111 | x := mthing^.x Shl FRACBITS; 112 | y := mthing^.y Shl FRACBITS; 113 | 114 | // spawn a teleport fog at the new spot 115 | ss := R_PointInSubsector(x, y); 116 | mo := P_SpawnMobj(x, y, ss^.sector^.floorheight, MT_IFOG); 117 | S_StartSound(mo, sfx_itmbk); 118 | 119 | // find which type to spawn 120 | j := integer(NUMMOBJTYPES); 121 | For j := 0 To integer(NUMMOBJTYPES) - 1 Do Begin 122 | If (mthing^._type = mobjinfo[j].doomednum) Then Begin 123 | i := j; 124 | break; 125 | End; 126 | End; 127 | 128 | If (i >= integer(NUMMOBJTYPES)) Then Begin 129 | I_Error(format('P_RespawnSpecials: Failed to find mobj type with doomednum ' + 130 | '%d when respawning thing. This would cause a buffer overrun ' + 131 | 'in vanilla Doom', [mthing^._type])); 132 | End; 133 | 134 | // spawn it 135 | If (mobjinfo[i].flags And MF_SPAWNCEILING) <> 0 Then 136 | z := ONCEILINGZ 137 | Else 138 | z := ONFLOORZ; 139 | 140 | mo := P_SpawnMobj(x, y, z, mobjtype_t(i)); 141 | mo^.spawnpoint := mthing^; 142 | mo^.angle := angle_t(ANG45 * (mthing^.angle Div 45)); 143 | 144 | // pull it from the que 145 | iquetail := (iquetail + 1) And (ITEMQUESIZE - 1); 146 | End; 147 | 148 | Procedure P_Ticker(); 149 | Var 150 | i: int; 151 | Begin 152 | // run the tic 153 | If (paused <> 0) Then exit; 154 | 155 | // pause if in menu and at least one tic has been run 156 | If (Not netgame) 157 | And (menuactive) 158 | And (Not demoplayback) 159 | And (players[consoleplayer].viewz <> 1) Then Begin 160 | exit; 161 | End; 162 | 163 | For i := 0 To MAXPLAYERS - 1 Do Begin 164 | If (playeringame[i]) Then 165 | P_PlayerThink(@players[i]); 166 | End; 167 | 168 | P_RunThinkers(); 169 | P_UpdateSpecials(); 170 | P_RespawnSpecials(); 171 | 172 | // for par times 173 | leveltime := leveltime + 1; 174 | End; 175 | 176 | // 177 | // P_RemoveThinker 178 | // Deallocation is lazy -- it will not actually be freed 179 | // until its thinking turn comes up. 180 | // 181 | 182 | Procedure P_RemoveThinker(thinker: Pthinker_t); 183 | Begin 184 | // FIXME: NOP. 185 | thinker^._function.acv := Nil; 186 | End; 187 | 188 | End. 189 | 190 | -------------------------------------------------------------------------------- /src/units/r_defs.pas: -------------------------------------------------------------------------------- 1 | Unit r_defs; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , doomtype, tables 10 | , i_video 11 | , m_fixed 12 | , info_types 13 | ; 14 | 15 | Const 16 | // Silhouette, needed for clipping Segs (mainly) 17 | // and sprites representing things. 18 | SIL_NONE = 0; 19 | SIL_BOTTOM = 1; 20 | SIL_TOP = 2; 21 | SIL_BOTH = 3; 22 | 23 | MAXDRAWSEGS = 256; 24 | 25 | Type 26 | 27 | laserpatch_t = Record 28 | c: char; 29 | a: String; 30 | l, w, h: int; 31 | End; 32 | 33 | // This could be wider for >8 bit display. 34 | // Indeed, true color support is posibble 35 | // precalculating 24bpp lightmap/colormap LUT. 36 | // from darkening PLAYPAL to all black. 37 | // Could even us emore than 32 levels. 38 | lighttable_t = pixel_t; 39 | 40 | Plighttable_t = ^lighttable_t; 41 | 42 | (* 43 | 44 | !!!!!!!!!! ACHTUNG !!!!!!!!!! 45 | ettliche typen sind aus zirkulären abhängigkeitsgründen 46 | nach info_types.pas gewandert ! 47 | 48 | *) 49 | 50 | // 51 | // The SideDef. 52 | // 53 | 54 | side_t = Record 55 | 56 | // add this to the calculated texture column 57 | textureoffset: fixed_t; 58 | 59 | // add this to the calculated texture top 60 | rowoffset: fixed_t; 61 | 62 | // Texture indices. 63 | // We do not maintain names here. 64 | toptexture: short; 65 | bottomtexture: short; 66 | midtexture: short; 67 | 68 | // Sector the SideDef is facing. 69 | sector: ^sector_t; 70 | 71 | // [crispy] smooth texture scrolling 72 | basetextureoffset: fixed_t; 73 | End; 74 | Pside_t = ^side_t; 75 | 76 | // 77 | // The LineSeg. 78 | // 79 | 80 | seg_t = Record 81 | 82 | v1: Pvertex_t; // Ist tatsächlich nur 1er aber halt ein pointer darauf 83 | v2: Pvertex_t; // Ist tatsächlich nur 1er aber halt ein pointer darauf 84 | 85 | offset: fixed_t; 86 | 87 | angle: angle_t; 88 | 89 | sidedef: ^side_t; 90 | linedef: ^line_t; 91 | 92 | // Sector references. 93 | // Could be retrieved from linedef, too. 94 | // backsector is NULL for one sided lines 95 | frontsector: ^sector_t; 96 | backsector: ^sector_t; 97 | 98 | length: uint32_t; // [crispy] fix long wall wobble 99 | r_angle: angle_t; // [crispy] re-calculated angle used for rendering 100 | fakecontrast: int; 101 | End; 102 | pseg_t = ^seg_t; 103 | 104 | 105 | Pvissprite_t = ^vissprite_t; 106 | // A vissprite_t is a thing 107 | // that will be drawn during a refresh. 108 | // I.e. a sprite object that is partly visible. 109 | vissprite_t = Record 110 | 111 | // Doubly linked list. 112 | prev: Pvissprite_t; 113 | next: Pvissprite_t; 114 | 115 | x1: int; 116 | x2: int; 117 | 118 | // for line side calculation 119 | gx: fixed_t; 120 | gy: fixed_t; 121 | 122 | // global bottom / top for silhouette clipping 123 | gz: fixed_t; 124 | gzt: fixed_t; 125 | 126 | // horizontal position of x1 127 | startfrac: fixed_t; 128 | 129 | scale: fixed_t; 130 | 131 | // negative if flipped 132 | xiscale: fixed_t; 133 | 134 | texturemid: fixed_t; 135 | patch: int; 136 | 137 | // for color translation and shadow draw, 138 | // maxbright frames as well 139 | // [crispy] brightmaps for select sprites 140 | colormap: Array[0..1] Of Plighttable_t; 141 | brightmap: Pbyte; 142 | 143 | mobjflags: int; 144 | // [crispy] color translation table for blood colored by monster class 145 | translation: Array Of byte; 146 | //#ifdef CRISPY_TRUECOLOR 147 | // const pixel_t (*blendfunc)(const pixel_t fg, const pixel_t bg); 148 | //#endif 149 | End; 150 | 151 | 152 | // 153 | // Sprites are patches with a special naming convention 154 | // so they can be recognized by R_InitSprites. 155 | // The base name is NNNNFx or NNNNFxFx, with 156 | // x indicating the rotation, x = 0, 1-7. 157 | // The sprite and frame specified by a thing_t 158 | // is range checked at run time. 159 | // A sprite is a patch_t that is assumed to represent 160 | // a three dimensional object and may have multiple 161 | // rotations pre drawn. 162 | // Horizontal flipping is used to save space, 163 | // thus NNNNF2F5 defines a mirrored patch. 164 | // Some sprites will only have one picture used 165 | // for all views: NNNNF0 166 | // 167 | spriteframe_t = Record 168 | 169 | // If false use 0 for any position. 170 | // Note: as eight entries are available, 171 | // we might as well insert the same name eight times. 172 | rotate: int; // [crispy] we use a value of 2 for 16 sprite rotations 173 | 174 | // Lump to use for view angles 0-7. 175 | lump: Array[0..15] Of short; // [crispy] support 16 sprite rotations 176 | 177 | // Flip bit (1 = flip) to use for view angles 0-7. 178 | flip: Array[0..15] Of byte; // [crispy] support 16 sprite rotations 179 | 180 | End; 181 | // Pspriteframe_t = ^spriteframe_t; 182 | 183 | // 184 | // A sprite definition: 185 | // a number of animation frames. 186 | // 187 | spritedef_t = Record 188 | numframes: int; 189 | spriteframes: Array Of spriteframe_t; 190 | End; 191 | 192 | // 193 | // Now what is a visplane, anyway? 194 | // 195 | visplane_t = Record 196 | 197 | height: fixed_t; 198 | picnum: int; 199 | lightlevel: int; 200 | minx: int; 201 | maxx: int; 202 | 203 | // Here lies the rub for all 204 | // dynamic resize/change of resolution. 205 | top: Array[-1..MAXWIDTH] Of unsigned_int; // leave pads for [minx-1]/[maxx+1] 206 | // See above. 207 | bottom: Array[-1..MAXWIDTH] Of unsigned_int; // leave pads for [minx-1]/[maxx+1] 208 | End; 209 | 210 | Pvisplane_t = ^visplane_t; 211 | 212 | // 213 | // ? 214 | // 215 | drawseg_t = Record 216 | 217 | curline: Pseg_t; 218 | x1: int; 219 | x2: int; 220 | 221 | scale1: fixed_t; 222 | scale2: fixed_t; 223 | scalestep: fixed_t; 224 | 225 | // 0=none, 1=bottom, 2=top, 3=both 226 | silhouette: int; 227 | 228 | // do not clip sprites above this 229 | bsilheight: fixed_t; 230 | 231 | // do not clip sprites below this 232 | tsilheight: fixed_t; 233 | 234 | // Pointers to lists for sprite clipping, 235 | // all three adjusted so [x1] is first value. 236 | sprtopclip: P_int; // [crispy] 32-bit integer math 237 | sprbottomclip: P_int; // [crispy] 32-bit integer math 238 | maskedtexturecol: P_int; // [crispy] 32-bit integer math 239 | End; 240 | 241 | Implementation 242 | 243 | End. 244 | 245 | -------------------------------------------------------------------------------- /src/units/r_sky.pas: -------------------------------------------------------------------------------- 1 | Unit r_sky; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Const 11 | // The sky map is 256*128*4 maps. 12 | ANGLETOSKYSHIFT = 22; 13 | 14 | // [crispy] stretch sky 15 | SKYSTRETCH_HEIGHT = 228; 16 | 17 | // SKY, store the number for name. 18 | SKYFLATNAME = 'F_SKY1'; 19 | 20 | Var 21 | // 22 | // sky mapping 23 | // 24 | skyflatnum: int; 25 | skytexture: int = -1; // [crispy] initialize 26 | skytexturemid: int; 27 | 28 | Procedure R_InitSkyMap(); 29 | 30 | Implementation 31 | 32 | Uses 33 | r_data 34 | , m_fixed 35 | , i_video 36 | ; 37 | 38 | Procedure R_InitSkyMap(); 39 | Var 40 | skyheight: int; 41 | Begin 42 | 43 | // [crispy] stretch short skies 44 | If (skytexture = -1) Then Begin 45 | exit; 46 | End; 47 | 48 | crispy.stretchsky := (crispy.freelook <> 0) Or (crispy.mouselook <> 0) Or (crispy.pitch <> 0); 49 | skyheight := textureheight[skytexture] Shr FRACBITS; 50 | 51 | If (crispy.stretchsky) And (skyheight < 200) Then Begin 52 | skytexturemid := -28 * FRACUNIT; 53 | End 54 | Else If (skyheight >= 200) Then Begin 55 | skytexturemid := 200 * FRACUNIT; 56 | End 57 | Else Begin 58 | skytexturemid := ORIGHEIGHT Div 2 * FRACUNIT; 59 | End; 60 | End; 61 | 62 | End. 63 | 64 | -------------------------------------------------------------------------------- /src/units/r_swirl.pas: -------------------------------------------------------------------------------- 1 | Unit r_swirl; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Procedure R_InitDistortedFlats(); 11 | 12 | Implementation 13 | 14 | Const 15 | AMP = 2; 16 | AMP2 = 2; 17 | SPEED = 32; 18 | 19 | 20 | Procedure R_InitDistortedFlats(); 21 | Begin 22 | Raise Exception.Create('Port me.'); 23 | // if (!offsets) 24 | // { 25 | // int i; 26 | // 27 | // offsets = I_Realloc(offsets, SEQUENCE * FLATSIZE * sizeof(*offsets)); 28 | // offset = offsets; 29 | // 30 | // for (i = 0; i < SEQUENCE; i++) 31 | // { 32 | // int x, y; 33 | // 34 | // for (x = 0; x < 64; x++) 35 | // { 36 | // for (y = 0; y < 64; y++) 37 | // { 38 | // int x1, y1; 39 | // int sinvalue, sinvalue2; 40 | // 41 | // sinvalue = (y * swirlfactor + i * SPEED * 5 + 900) & FINEMASK; 42 | // sinvalue2 = (x * swirlfactor2 + i * SPEED * 4 + 300) & FINEMASK; 43 | // x1 = x + 128 44 | // + ((finesine[sinvalue] * AMP) >> FRACBITS) 45 | // + ((finesine[sinvalue2] * AMP2) >> FRACBITS); 46 | // 47 | // sinvalue = (x * swirlfactor + i * SPEED * 3 + 700) & FINEMASK; 48 | // sinvalue2 = (y * swirlfactor2 + i * SPEED * 4 + 1200) & FINEMASK; 49 | // y1 = y + 128 50 | // + ((finesine[sinvalue] * AMP) >> FRACBITS) 51 | // + ((finesine[sinvalue2] * AMP2) >> FRACBITS); 52 | // 53 | // x1 &= 63; 54 | // y1 &= 63; 55 | // 56 | // offset[(y << 6) + x] = (y1 << 6) + x1; 57 | // } 58 | // } 59 | // 60 | // offset += FLATSIZE; 61 | // } 62 | // } 63 | 64 | End; 65 | 66 | End. 67 | 68 | -------------------------------------------------------------------------------- /src/units/s_musinfo.pas: -------------------------------------------------------------------------------- 1 | Unit s_musinfo; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , info_types 10 | ; 11 | 12 | Type 13 | musinfo_t = Record 14 | mapthing: Pmobj_t; 15 | lastmapthing: Pmobj_t; 16 | tics: int; 17 | // int current_item; 18 | // int items[MAX_MUS_ENTRIES]; 19 | from_savegame: boolean; 20 | End; 21 | Var 22 | 23 | musinfo: musinfo_t; 24 | 25 | Procedure S_ParseMusInfo(mapid: String); 26 | 27 | Procedure T_MusInfo(); 28 | 29 | Implementation 30 | 31 | Procedure S_ParseMusInfo(mapid: String); 32 | Begin 33 | 34 | End; 35 | 36 | Procedure T_MusInfo(); 37 | Begin 38 | 39 | End; 40 | 41 | End. 42 | 43 | -------------------------------------------------------------------------------- /src/units/s_sound.pas: -------------------------------------------------------------------------------- 1 | Unit s_sound; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , sounds, info_types 10 | ; 11 | 12 | Var 13 | musicVolume: integer = 8; 14 | 15 | Procedure S_StartSound(origin_p: Pointer; sfx_id: sfxenum_t); 16 | Procedure S_StartSoundOptional(origin_p: Pointer; sfx_id: sfxenum_t; old_sfx_id: sfxenum_t); 17 | Procedure S_StartMusic(m_id: musicenum_t); 18 | Procedure S_ChangeMusic(music_id: musicenum_t; looping: boolean); 19 | 20 | Procedure S_ResumeSound(); 21 | Procedure S_PauseSound(); 22 | 23 | Procedure S_Start(); 24 | Procedure S_StartSoundOnce(origin_p: Pointer; sfx_id: sfxenum_t); 25 | 26 | Procedure S_UnlinkSound(origin: Pmobj_t); 27 | Procedure S_StopSound(origin: Pmobj_t); 28 | 29 | Procedure S_Shutdown(); 30 | 31 | Implementation 32 | 33 | Uses 34 | doomdef 35 | , d_loop 36 | , g_game 37 | , i_sound 38 | ; 39 | 40 | Var 41 | snd_SfxVolume: integer = 10000; // Full Sound 42 | mus_paused: Boolean = false; 43 | mus_playing: Boolean = false; 44 | 45 | procedure S_StartSound(origin_p: Pointer; sfx_id: sfxenum_t); 46 | Var 47 | sfx: ^sfxinfo_t; 48 | origin: Pmobj_t; 49 | // int rc; 50 | // int sep; 51 | // int pitch; 52 | // int cnum; 53 | // int volume; 54 | 55 | Begin 56 | origin := origin_p; 57 | // volume = snd_SfxVolume; 58 | // 59 | // [crispy] make non-fatal, consider zero volume 60 | If (sfx_id = sfx_None) Or (snd_SfxVolume = 0) Or (nodrawers And singletics) Then Begin 61 | exit; 62 | End; 63 | // // check for bogus sound # 64 | // if (sfx_id < 1 || sfx_id > NUMSFX) 65 | // { 66 | // I_Error("Bad sfx #: %d", sfx_id); 67 | // } 68 | 69 | sfx := @S_sfx[integer(sfx_id)]; 70 | 71 | // // Initialize sound parameters 72 | // pitch = NORM_PITCH; 73 | // if (sfx->link) 74 | // { 75 | // volume += sfx->volume; 76 | // pitch = sfx->pitch; 77 | // 78 | // if (volume < 1) 79 | // { 80 | // return; 81 | // } 82 | // 83 | // if (volume > snd_SfxVolume) 84 | // { 85 | // volume = snd_SfxVolume; 86 | // } 87 | // } 88 | // 89 | // 90 | // // Check to see if it is audible, 91 | // // and if not, modify the params 92 | // if (origin && origin != players[displayplayer].mo && origin != players[displayplayer].so) // [crispy] weapon sound source 93 | // { 94 | // rc = S_AdjustSoundParams(players[displayplayer].mo, 95 | // origin, 96 | // &volume, 97 | // &sep); 98 | // 99 | // if (origin->x == players[displayplayer].mo->x 100 | // && origin->y == players[displayplayer].mo->y) 101 | // { 102 | // sep = NORM_SEP; 103 | // } 104 | // 105 | // if (!rc) 106 | // { 107 | // return; 108 | // } 109 | // } 110 | // else 111 | // { 112 | // sep = NORM_SEP; 113 | // } 114 | // 115 | // // hacks to vary the sfx pitches 116 | // if (sfx_id >= sfx_sawup && sfx_id <= sfx_sawhit) 117 | // { 118 | // pitch += 8 - (M_Random()&15); 119 | // } 120 | // else if (sfx_id != sfx_itemup && sfx_id != sfx_tink) 121 | // { 122 | // pitch += 16 - (M_Random()&31); 123 | // } 124 | // pitch = Clamp(pitch); 125 | 126 | // kill old sound 127 | If (crispy.soundfull = 0) Or assigned(origin) Or (gamestate <> GS_LEVEL) Then Begin 128 | S_StopSound(origin); 129 | End; 130 | 131 | // // try to find a channel 132 | // cnum = S_GetChannel(origin, sfx); 133 | // 134 | // if (cnum < 0) 135 | // { 136 | // return; 137 | // } 138 | // 139 | // // increase the usefulness 140 | // if (sfx->usefulness++ < 0) 141 | // { 142 | // sfx->usefulness = 1; 143 | // } 144 | 145 | If (sfx^.lumpnum < 0) Then Begin 146 | sfx^.lumpnum := I_GetSfxLumpNum(sfx); 147 | End; 148 | 149 | // channels[cnum].pitch = pitch; 150 | // channels[cnum].handle = 151 | I_StartSound(sfx, 0, 100, 0, NORM_PITCH); 152 | End; 153 | 154 | procedure S_StartSoundOptional(origin_p: Pointer; sfx_id: sfxenum_t; 155 | old_sfx_id: sfxenum_t); 156 | Begin 157 | // Umleiten nach Bass ? 158 | If (I_GetSfxLumpNum(@S_sfx[integer(sfx_id)]) <> -1) Then Begin 159 | S_StartSound(origin_p, sfx_id); 160 | End 161 | Else If (old_sfx_id <> sfx_None) Then Begin // Play a fallback? 162 | S_StartSound(origin_p, old_sfx_id); 163 | End; 164 | End; 165 | 166 | procedure S_StartMusic(m_id: musicenum_t); 167 | Begin 168 | // S_ChangeMusic(m_id, false); 169 | nop(); 170 | End; 171 | 172 | procedure S_ChangeMusic(music_id: musicenum_t; looping: boolean); 173 | Begin 174 | 175 | End; 176 | 177 | procedure S_ResumeSound; 178 | Begin 179 | If (mus_playing) And (mus_paused) Then Begin 180 | 181 | // I_ResumeSong(); 182 | mus_paused := false; 183 | End; 184 | End; 185 | 186 | procedure S_PauseSound; 187 | Begin 188 | If (mus_playing) And (Not mus_paused) Then Begin 189 | 190 | // I_PauseSong(); 191 | mus_paused := true; 192 | End; 193 | End; 194 | 195 | 196 | // 197 | // Per level startup code. 198 | // Kills playing sounds at start of level, 199 | // determines music if any, changes music. 200 | // 201 | 202 | procedure S_Start; 203 | Begin 204 | nop(); 205 | 206 | End; 207 | 208 | procedure S_StartSoundOnce(origin_p: Pointer; sfx_id: sfxenum_t); 209 | Begin 210 | nop(); 211 | 212 | // int cnum; 213 | // const sfxinfo_t *const sfx = &S_sfx[sfx_id]; 214 | // 215 | // for (cnum = 0; cnum < snd_channels; cnum++) 216 | // { 217 | // if (channels[cnum].sfxinfo == sfx && 218 | // channels[cnum].origin == origin_p) 219 | // { 220 | // return; 221 | // } 222 | // } 223 | // 224 | // S_StartSound(origin_p, sfx_id); 225 | End; 226 | 227 | // [crispy] removed map objects may finish their sounds 228 | // When map objects are removed from the map by P_RemoveMobj(), instead of 229 | // stopping their sounds, their coordinates are transfered to "sound objects" 230 | // so stereo positioning and distance calculations continue to work even after 231 | // the corresponding map object has already disappeared. 232 | // Thanks to jeff-d and kb1 for discussing this feature and the former for the 233 | // original implementation idea: https://www.doomworld.com/vb/post/1585325 234 | 235 | procedure S_UnlinkSound(origin: Pmobj_t); 236 | Begin 237 | nop(); 238 | 239 | // int cnum; 240 | // 241 | // if (origin) 242 | // { 243 | // for (cnum=0 ; cnum<snd_channels ; cnum++) 244 | // { 245 | // if (channels[cnum].sfxinfo && channels[cnum].origin == origin) 246 | // { 247 | // degenmobj_t *const sobj = &sobjs[cnum]; 248 | // sobj->x = origin->x; 249 | // sobj->y = origin->y; 250 | // sobj->z = origin->z; 251 | // channels[cnum].origin = (mobj_t *) sobj; 252 | // break; 253 | // } 254 | // } 255 | // } 256 | End; 257 | 258 | procedure S_StopSound(origin: Pmobj_t); 259 | Begin 260 | nop(); 261 | 262 | // int cnum; 263 | // 264 | // for (cnum=0 ; cnum<snd_channels ; cnum++) 265 | // { 266 | // if (channels[cnum].sfxinfo && channels[cnum].origin == origin) 267 | // { 268 | // S_StopChannel(cnum); 269 | // break; 270 | // } 271 | // } 272 | End; 273 | 274 | procedure S_Shutdown; 275 | Begin 276 | I_ShutdownSound(); 277 | //I_ShutdownMusic(); 278 | End; 279 | 280 | End. 281 | 282 | -------------------------------------------------------------------------------- /src/units/statdump.pas: -------------------------------------------------------------------------------- 1 | Unit statdump; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , d_player 10 | ; 11 | 12 | Procedure StatCopy(stats: Pwbstartstruct_t); 13 | 14 | Implementation 15 | 16 | Uses 17 | m_argv 18 | ; 19 | 20 | Const 21 | MAX_CAPTURES = 32; 22 | 23 | Var 24 | num_captured_stats: int = 0; 25 | captured_stats: Array[0..MAX_CAPTURES - 1] Of wbstartstruct_t; 26 | 27 | Procedure StatCopy(stats: Pwbstartstruct_t); 28 | Begin 29 | If (M_ParmExists('-statdump') And (num_captured_stats < MAX_CAPTURES)) Then Begin 30 | Raise exception.create('Port me.'); 31 | // memcpy(&captured_stats[num_captured_stats], stats, 32 | // sizeof(wbstartstruct_t)); 33 | // ++num_captured_stats; 34 | End; 35 | End; 36 | 37 | End. 38 | 39 | -------------------------------------------------------------------------------- /src/units/usdl_wrapper.pas: -------------------------------------------------------------------------------- 1 | Unit usdl_wrapper; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils, Graphics; 9 | //Uses Forms, Graphics, config, IntfGraphics, FPImage, unit1; 10 | 11 | Type 12 | SDL_Surface = TBitmap; 13 | SDL_Window = Pointer; // TODO: Noch Klären was das sein könnte ;) 14 | 15 | // Nicht 1:1 implementiert, aber funktioniert ;) 16 | // https://wiki.libsdl.org/SDL2/SDL_CreateRGBSurfaceFrom 17 | Function SDL_CreateRGBSurfaceFrom( 18 | pixels: P_unsigned_int; 19 | width: int; 20 | height: int; 21 | depth: int; 22 | pitch: int; 23 | RMask: UInt32; 24 | GMask: UInt32; 25 | BMask: UInt32; 26 | AMask: UInt32 27 | ): SDL_Surface; 28 | 29 | // https://wiki.libsdl.org/SDL2/SDL_FreeSurface 30 | Procedure SDL_FreeSurface(surface: SDL_Surface); 31 | 32 | // https://wiki.libsdl.org/SDL2/SDL_SetWindowTitle 33 | Procedure SDL_SetWindowTitle(window: SDL_Window; title: String); 34 | 35 | // https://wiki.libsdl.org/SDL2/SDL_SetWindowIcon 36 | Procedure SDL_SetWindowIcon(window: SDL_Window; icon: SDL_Surface); 37 | 38 | Implementation 39 | 40 | Uses unit1, forms, IntfGraphics, FPImage; 41 | 42 | function SDL_CreateRGBSurfaceFrom(pixels: P_unsigned_int; width: int; 43 | height: int; depth: int; pitch: int; RMask: UInt32; GMask: UInt32; 44 | BMask: UInt32; AMask: UInt32): SDL_Surface; 45 | Var 46 | i, j: Integer; 47 | col: unsigned_int; 48 | fcol: TFPColor; 49 | TempIntfImg: TLazIntfImage; 50 | Begin 51 | result := TBitmap.Create; 52 | result.Width := width; 53 | result.Height := height; 54 | TempIntfImg := TLazIntfImage.Create(0, 0); 55 | TempIntfImg.LoadFromBitmap(result.Handle, result.MaskHandle); 56 | // TODO: Kann sein, dass das mit dem Alpha noch nicht ganz stimmt, aber prinzipiel gehts :) 57 | For i := 0 To width - 1 Do Begin 58 | For j := 0 To height - 1 Do Begin 59 | col := pixels[j * height + i]; 60 | fcol.Red := (col Shr 16) And $FF00; 61 | fcol.Green := (col Shr 8) And $FF00; 62 | fcol.Blue := (col) And $FF00; 63 | fcol.Alpha := (col Shr 8) And $FF00; 64 | TempIntfImg.Colors[i, j] := fcol; 65 | End; 66 | End; 67 | result.LoadFromIntfImage(TempIntfImg); 68 | TempIntfImg.free; 69 | End; 70 | 71 | procedure SDL_FreeSurface(surface: SDL_Surface); 72 | Begin 73 | If assigned(surface) Then surface.Free; 74 | End; 75 | 76 | procedure SDL_SetWindowTitle(window: SDL_Window; title: String); 77 | Begin 78 | Application.Title := title; 79 | form1.Caption := Application.Title; 80 | End; 81 | 82 | procedure SDL_SetWindowIcon(window: SDL_Window; icon: SDL_Surface); 83 | Begin 84 | Application.Icon.Assign(icon); 85 | End; 86 | 87 | End. 88 | 89 | -------------------------------------------------------------------------------- /src/units/v_diskicon.pas: -------------------------------------------------------------------------------- 1 | Unit v_diskicon; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Procedure V_RestoreDiskBackground(); 11 | 12 | Implementation 13 | 14 | Procedure V_RestoreDiskBackground(); 15 | Begin 16 | // if (disk_drawn) 17 | // { 18 | // // Restore the background. 19 | // CopyRegion(DiskRegionPointer(), SCREENWIDTH, 20 | // saved_background, LOADING_DISK_W, 21 | // LOADING_DISK_W, LOADING_DISK_H); 22 | // 23 | // disk_drawn = false; 24 | // } 25 | End; 26 | 27 | 28 | 29 | End. 30 | 31 | -------------------------------------------------------------------------------- /src/units/v_patch.pas: -------------------------------------------------------------------------------- 1 | Unit v_patch; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Type 11 | 12 | // Patches. 13 | // A patch holds one or more columns. 14 | // Patches are used for sprites and all masked pictures, 15 | // and we compose textures from the TEXTURE1/2 lists 16 | // of patches. 17 | 18 | patch_t = Packed Record 19 | width: short; // bounding box size 20 | height: short; 21 | leftoffset: short; // pixels to the left of origin 22 | topoffset: short; // pixels below the origin 23 | columnofs: Array[0..65535] Of Int; // Eigentlich sind nur width Elemente Gültig, aber da sich das immer ändert schalten wir so die Boundary Check funktion aus .. 24 | End; 25 | Ppatch_t = ^patch_t; 26 | PPpatch_t = ^Ppatch_t; // Das ist eigentlich ein Array of Ppatch_t 27 | patch_tArray = Packed Array[0..$FFFF] Of patch_t; 28 | Ppatch_tArray = ^patch_tArray; 29 | patch_tPArray = Packed Array[0..$FFFF] Of Ppatch_t; 30 | Ppatch_tPArray = ^patch_tPArray; 31 | 32 | // posts are runs of non masked source pixels 33 | post_t = Packed Record 34 | topdelta: byte; // -1 is the last post in a column 35 | length: byte; // length data bytes follows 36 | End; 37 | Ppost_t = ^post_t; 38 | 39 | // column_t is a list of 0 or more post_t, (byte)-1 terminated 40 | column_t = post_t; 41 | Pcolumn_t = ^column_t; 42 | 43 | Implementation 44 | 45 | End. 46 | 47 | -------------------------------------------------------------------------------- /src/units/v_snow.pas: -------------------------------------------------------------------------------- 1 | Unit v_snow; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Procedure V_SnowUpdate(); 11 | 12 | Procedure V_SnowDraw(); 13 | 14 | Implementation 15 | 16 | Procedure V_SnowUpdate(); 17 | Begin 18 | Raise Exception.Create('Port me.'); 19 | // size_t i; 20 | // 21 | // if (last_screen_size != (SCREENHEIGHT * SCREENWIDTH)) 22 | // ResetSnow(); 23 | // 24 | // if (Crispy_Random() % 20 == 4) 25 | // wind = 1 - Crispy_Random() % 3; 26 | // 27 | // for (i = 0; i < snowflakes_num; i++) 28 | // { 29 | // snowflakes[i].y += Crispy_Random() % 4; 30 | // 31 | // snowflakes[i].x += 1 - Crispy_Random() % 3; 32 | // snowflakes[i].x += wind; 33 | // 34 | // if (snowflakes[i].y >= SCREENHEIGHT) 35 | // snowflakes[i].y = 0; 36 | // if (snowflakes[i].x >= SCREENWIDTH) 37 | // snowflakes[i].x = snowflakes[i].x - SCREENWIDTH; 38 | // if (snowflakes[i].x < 0) 39 | // snowflakes[i].x = SCREENWIDTH + snowflakes[i].x; 40 | // } 41 | End; 42 | 43 | Procedure V_SnowDraw(); 44 | Begin 45 | Raise Exception.Create('Port me.'); 46 | // size_t i; 47 | // 48 | // for (i = 0; i < snowflakes_num; i++) 49 | // { 50 | // int video_offset; 51 | // 52 | // if (snowflakes[i].y < 0) 53 | // continue; 54 | // 55 | // video_offset = snowflakes[i].x + snowflakes[i].y * SCREENWIDTH; 56 | // I_VideoBuffer[video_offset] = snowflakes_color; 57 | // } 58 | End; 59 | 60 | End. 61 | 62 | -------------------------------------------------------------------------------- /src/units/w_file.pas: -------------------------------------------------------------------------------- 1 | Unit w_file; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Type 11 | 12 | _wad_file_s = Record 13 | 14 | // Class of this file. 15 | // wad_file_class_t *file_class; 16 | 17 | // If this is NULL, the file cannot be mapped into memory. If this 18 | // is non-NULL, it is a pointer to the mapped file. 19 | mapped: TMemoryStream; 20 | 21 | // Length of the file, in bytes. 22 | length: unsigned_int; // WTF: Warum ist das nur 32-Bit ? 23 | 24 | // File's location on disk. 25 | path: String; // [crispy] un-const 26 | End; 27 | 28 | 29 | wad_file_t = _wad_file_s; 30 | 31 | // p_wad_file_t = ^wad_file_t; 32 | 33 | Function W_OpenFile(path: String): wad_file_t; 34 | 35 | 36 | // Read data from the specified file into the provided buffer. The 37 | // data is read from the specified offset from the start of the file. 38 | // Returns the number of bytes read. 39 | 40 | Function W_Read(Const wad: wad_file_t; offset: unsigned_int; Out buffer; buffer_len: size_t): size_t; 41 | 42 | Procedure W_CloseFile(Var wad: wad_file_t); 43 | 44 | Implementation 45 | 46 | Function W_OpenFile(path: String): wad_file_t; 47 | Begin 48 | If FileExists(path) Then Begin 49 | //! 50 | // @category obscure 51 | // 52 | // Use the OS's virtual memory subsystem to map WAD files 53 | // directly into memory. 54 | // 55 | 56 | // If (!M_CheckParm("-mmap")) 57 | // { 58 | // return stdc_wad_file.OpenFile(path); 59 | // } 60 | result.mapped := TMemoryStream.Create; 61 | Result.mapped.LoadFromFile(path); 62 | Result.length := Result.mapped.Size; 63 | // Try all classes in order until we find one that works 64 | 65 | result.path := path; 66 | End 67 | Else Begin 68 | result.mapped := Nil; 69 | result.length := 0; 70 | result.path := ''; 71 | End; 72 | End; 73 | 74 | Function W_Read(Const wad: wad_file_t; offset: unsigned_int; Out buffer; 75 | buffer_len: size_t): size_t; 76 | Begin 77 | result := 0; 78 | If assigned(wad.mapped) Then Begin 79 | wad.mapped.Position := offset; 80 | result := wad.mapped.Read(buffer, buffer_len); 81 | End; 82 | End; 83 | 84 | Procedure W_CloseFile(Var wad: wad_file_t); 85 | Begin 86 | If assigned(wad.mapped) Then Begin 87 | wad.mapped.Free; 88 | End; 89 | wad.mapped := Nil; 90 | wad.length := 0; 91 | wad.path := ''; 92 | End; 93 | 94 | End. 95 | 96 | -------------------------------------------------------------------------------- /src/units/w_main.pas: -------------------------------------------------------------------------------- 1 | Unit w_main; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils 9 | , d_mode 10 | ; 11 | 12 | Procedure W_CheckCorrectIWAD(mission: GameMission_t); 13 | 14 | Implementation 15 | 16 | Uses 17 | w_wad 18 | , i_system 19 | ; 20 | 21 | // Lump names that are unique to particular game types. This lets us check 22 | // the user is not trying to play with the wrong executable, eg. 23 | // chocolate-doom -iwad hexen.wad. 24 | Type 25 | unique_lumps_t = Record 26 | mission: GameMission_t; 27 | lumpname: String; 28 | End; 29 | 30 | Const 31 | unique_lumps: Array Of unique_lumps_t = ( 32 | (mission: doom; lumpname: 'POSSA1'), 33 | (mission: heretic; lumpname: 'IMPXA1'), 34 | (mission: hexen; lumpname: 'ETTNA1'), 35 | (mission: strife; lumpname: 'AGRDA1') 36 | ); 37 | 38 | Procedure W_CheckCorrectIWAD(mission: GameMission_t); 39 | Var 40 | i: Integer; 41 | lumpnum: lumpindex_t; 42 | Begin 43 | For i := 0 To high(unique_lumps) Do Begin 44 | 45 | If (mission <> unique_lumps[i].mission) Then Begin 46 | lumpnum := W_CheckNumForName(unique_lumps[i].lumpname); 47 | 48 | If (lumpnum >= 0) Then Begin 49 | I_Error('W_CheckCorrectIWAD invalid .wad file for game.'); 50 | // TODO: Das hier noch richtig portieren! 51 | // I_Error("\nYou are trying to use a %s IWAD file with " 52 | // "the %s%s binary.\nThis isn't going to work.\n" 53 | // "You probably want to use the %s%s binary.", 54 | // D_SuggestGameName(unique_lumps[i].mission, 55 | // indetermined), 56 | // PROGRAM_PREFIX, 57 | // D_GameMissionString(mission), 58 | // PROGRAM_PREFIX, 59 | // D_GameMissionString(unique_lumps[i].mission)); 60 | End; 61 | End; 62 | End; 63 | End; 64 | 65 | End. 66 | 67 | -------------------------------------------------------------------------------- /src/units/z_zone.pas: -------------------------------------------------------------------------------- 1 | Unit z_zone; 2 | 3 | {$MODE ObjFPC}{$H+} 4 | 5 | Interface 6 | 7 | Uses 8 | ufpc_doom_types, Classes, SysUtils; 9 | 10 | Const 11 | PU_STATIC = 1; // static entire execution time 12 | PU_SOUND = 2; // static while playing 13 | PU_MUSIC = 3; // static while playing 14 | PU_FREE = 4; // a free block 15 | PU_LEVEL = 5; // static until level exited 16 | PU_LEVSPEC = 6; // a special thinker in a level 17 | 18 | // Tags >= PU_PURGELEVEL are purgable whenever needed. 19 | 20 | PU_PURGELEVEL = 100; 21 | PU_CACHE = 101; 22 | 23 | // Total number of different tag types 24 | 25 | PU_NUM_TAGS = 8; 26 | 27 | Procedure Z_Init(); 28 | Function Z_Malloc(size: int; tag: int; Var ptr: Pointer): pointer; 29 | Procedure Z_Free(Var ptr: Pointer); 30 | Procedure Z_FreeTags(lowtag, hightag: int); 31 | Procedure Z_DumpHeap(lowtag, hightag: int); 32 | // Procedure Z_FileDumpHeap (FILE *f); 33 | Procedure Z_CheckHeap(); 34 | // Procedure Z_ChangeTag2 (void *ptr, int tag, const char *file, int line); 35 | // Procedure Z_ChangeUser(void *ptr, void **user); 36 | Function Z_FreeMemory(): int; 37 | Function Z_ZoneSize(): unsigned_int; 38 | 39 | Implementation 40 | 41 | Procedure Z_Init(); 42 | Begin 43 | 44 | End; 45 | 46 | Function Z_Malloc(size: int; tag: int; Var ptr: Pointer): pointer; 47 | Begin 48 | 49 | End; 50 | 51 | Procedure Z_Free(Var ptr: Pointer); 52 | Begin 53 | 54 | End; 55 | 56 | Procedure Z_FreeTags(lowtag, hightag: int); 57 | Begin 58 | 59 | End; 60 | 61 | Procedure Z_DumpHeap(lowtag, hightag: int); 62 | Begin 63 | 64 | End; 65 | 66 | Procedure Z_CheckHeap(); 67 | Begin 68 | 69 | End; 70 | 71 | Function Z_FreeMemory(): int; 72 | Begin 73 | 74 | End; 75 | 76 | Function Z_ZoneSize(): unsigned_int; 77 | Begin 78 | 79 | End; 80 | 81 | End. 82 | 83 | --------------------------------------------------------------------------------