DooM - Afterburn bietet dir Informationen, FAQs, Tuts und downloadbare Dateien zu DooM und DooM-2. Dabei werden die Source-Ports jDoom, gzDoom, Doomsday, Risen3d und andere berücksichtigt. Doom als 3D-Spiel ist ein bekannter Horror-Shooter und Ego-Shooter.

Aber sorry, für die Ansicht dieser Seite ist ein modernerer Browser erforderlich !

    
Program WADRead;
{$M 65520, 0, 0}

{Interface}

Uses DOS, Crt, Strings, Mode13h;  { unit MODE13H at end of snipet }

Type
  String8 = String [8];
  TWAD_Type = (Internal, Patch);
  StringZ8 = Array [1..8] Of Char;
  
  TRawPalette = Array [1..768] Of Byte;
  PRawPalette = ^TRawPalette;

Const
  TWAD_TypeString: array [1..2] of string [4] = ('IWAD', 'PWAD');

Var
  WAD_File: file;
  WAD_Name: string;
  WAD_Type: TWAD_Type;
  WAD_NumEntries, WAD_DirectoryPointer: LongInt;
  RawTexture: array [1..32767] of Byte;
  RawPalette: array [1..768 * 14] of Byte;

{Implementation}

{Add a backslash to the end of a directory name}
{From my TTString unit, part of my TurboTools library}
function TT_AddSlash (S : string) : string;
Var
  L : Byte absolute S;

Begin
  If (L > 0) and (S [L] <> '\') Then
  Begin
    Inc (L);
    S [L] := '\';
  end;
  TT_AddSlash := S;
end;

{Fill out string with spaces}
{From TTString}
function TT_PadString (S: string; L: Integer) : string;
Var
  I: Integer;

Begin
  For I := Length (S) + 1 to L Do
    S [I] := #32;
  S [0] := Chr (L);
  TT_PadString := S;
end;


{Open the specified WAD file}
{If FileName = '' then try DOOM.WAD, DOOM2.WAD, then search}
{for the first WAD in the directory}
function WAD_Open (FileName: string): Boolean;
function WAD_OpenFile: Boolean;
Var
FileFound: SearchRec;

Begin
If Length (FileName) = 0 Then Begin
  {User hasn't specified a file name, open in the current directory}

    {Try to open DOOM.WAD in the current directory}
    Assign (WAD_File, 'DOOM.WAD');
    {$I-}
    Reset (WAD_File, 1);
    {$I+}
    if IOResult = 0 Then Begin
    {Succesfully opened DOOM.WAD}
      GetDir (0, WAD_Name);
      WAD_Name := TT_AddSlash (WAD_Name) + 'DOOM.WAD';
      WAD_OpenFile := True;
      Exit;
    end;

    {Couldn't open DOOM.WAD, try DOOM2.WAD}
    Assign (WAD_File, 'DOOM2.WAD';
    {$I-}
    Reset (WAD_File, 1;
    {$I+}
    if IOResult = 0 Then Begin
    {Succesfully opened DOOM2.WAD}
      GetDir (0, WAD_Name;
      WAD_Name := TT_AddSlash (WAD_Name) + 'DOOM2.WAD';
      WAD_OpenFile := True;
      Exit;
    end;

    {Couldn't open DOOM2.WAD, try opening the first WAD we find}
    FindFirst ('*.WAD', AnyFile, FileFound;
    if DOSError = 0 Then Begin
    {Found a WAD file}
      GetDir (0, WAD_Name;
      WAD_Name := TT_AddSlash (WAD_Name) + FileFound. Name;
      Assign (WAD_File, WAD_Name;
      {$I-}
      Reset (WAD_File, 1;
      {$I+}
      WAD_OpenFile := (IOResult = 0;
      Exit;
    end;

    {Couldn't open or find any WADs}
    WAD_OpenFile := False;
    Exit;
  End Else Begin
  {User specified a WAD file name}
    Assign (WAD_File, FileName;
    {$I-}
    Reset (WAD_File, 1;
    {$I+}
    if IOResult = 0 Then Begin
    {Succesfully opened specified WAD file}
      WAD_Name := FExpand (FileName;
      WAD_OpenFile := True;
      Exit;
    end;

    {Unable to open specified WAD file}
    WAD_OpenFile := False;
  end;
end;

Var
IDString: array [1..4] of Char;

Begin
  If WAD_OpenFile Then Begin
    {Check the first 4 byte to determine WAD type (and if it's valid)}
  BlockRead (WAD_File, IDString, 4;
    if IDString = TWAD_TypeString [1] Then
    WAD_Type := Internal
    else if IDString = TWAD_TypeString [2] Then
    WAD_Type := Patch
    Else Begin
    WAD_Open := False;
      Exit;
    end;
    {Read in the other header data, number of entries and the pointer to}
    {the directory at the end of the file}
    BlockRead (WAD_File, WAD_NumEntries, 4;
    BlockRead (WAD_File, WAD_DirectoryPointer, 4;
  End Else
  WAD_Open := False;
end;

{Read in directory entry EntryNum (0 based)}
function WAD_ReadEntry (EntryNum: LongInt; var Start, Length: LongInt; var Ent
Var
EntryNameZ: StringZ8;

Begin
  {$I-}
Seek (WAD_File, WAD_DirectoryPointer + (EntryNum * 16));
  {$I+}
  if IOResult = 0 Then Begin
  BlockRead (WAD_File, Start, 4;
  BlockRead (WAD_File, Length, 4;
  BlockRead (WAD_File, EntryNameZ, 8;
  EntryName := StrPas (@EntryNameZ;
    WAD_ReadEntry := True;
  End Else
    WAD_ReadEntry := False;
end;

{Search for directory entry with name EntryName (case sensitive)}
function WAD_FindEntry (EntryName: String8): LongInt;
Var
EntryNum, Start, Length: LongInt;
  CurEntryName: String8;

Begin
For EntryNum := 0 to WAD_NumEntries - 1 Do
  If Not WAD_ReadEntry (EntryNum, Start, Length, CurEntryName) Then Begin
    WAD_FindEntry := -2;
      Exit;
    End Else
    If CurEntryName = EntryName Then Begin
      WAD_FindEntry := EntryNum;
        Exit;
      end;
  WAD_FindEntry := -1;
end;

{Read in the data for a directory entry.  Use WAD_ReadEntry first}
function WAD_ReadEntryData (Start, Length: LongInt; Data: Pointer): Boolean;
Begin
  {$I-}
Seek (WAD_File, Start;
  BlockRead (WAD_File, Data^, Length;
  {$I+}
  WAD_ReadEntryData := (IOResult = 0;
end;

procedure WAD_DisplayTile (RawTexture: array of Byte;
Var
Line: Byte;

Begin
  For Line := 0 to 63 Do
  Move (RawTexture [Line * 64], Mem [$A000:Line * 320], 64;
{  Repeat Until KeyPressed;
  TextMode (LastMode);}
end;

procedure WAD_SetPalette (RawPalette: PRawPalette); {[1..768]}
Var
Color: Byte;

Begin
For Color := 0 to 255 Do
    Mode13h. SetCol (Color, RawPalette^ [Color * 3 + 1] div 4 ,
RawPalette^ [Color * 3 + 2] div 4,
RawPalette^ [Color * 3 + 3] div 4;
end;

procedure WAD_DisplaySprite (RawSprite: array of Byte;
Var
Width, Height, Left, Top, X, Y, Column: Word;
  ColumnOffset, PixelOffset: LongInt;
  Pixel, Count: Byte;

Begin
  Move (RawSprite [0], Width, 2;
  Move (RawSprite [2], Height, 2;
  Move (RawSprite [4], Left, 2;
  Move (RawSprite [6], Top, 2;
  for Column := 1 to Width Do Begin
    X := Column - 1;
    Move (RawSprite [4 + Column * 4], ColumnOffset, 4;

    Repeat
    {for each post}
      if not (RawSprite [ColumnOffset] = $FF) Then Begin
        Y := RawSprite [ColumnOffset];
        Count := RawSprite [ColumnOffset + 1];
        for PixelOffset := ColumnOffset + 3 to ColumnOffset + Count + 2 do Begin
          Inc (Y);
          PlotPixel (X, Y, RawSprite [PixelOffset]);
        end;
        ColumnOffset := ColumnOffset + Count + 4;
      end;
    until RawSprite [ColumnOffset] = $FF;
  end;
end;

Var
Entry, Start, Length: LongInt;
  Success: Boolean;
  EntryName, WhichEntry: String8;

Begin
  ClrScr;
  WriteLn ('Enter path to WAD file';
  Write (': ';
  ReadLn (WAD_Name;

  Success := WAD_Open (WAD_Name;
  if not Success Then Begin
  WriteLn ('Unable to open ' + WAD_Name;
    Halt;
  end;

  WriteLn ('Opened: ', WAD_Name;
  WriteLn ('Wad type: ', Ord (WAD_Type));
  WriteLn ('Num entries: ', WAD_NumEntries;
  WriteLn ('Pointer to Directory: ', WAD_DirectoryPointer;

  WriteLn;
  WriteLn ('Press any key to continue...';
  repeat until KeyPressed;
  ReadKey;

  WriteLn;
  WriteLn ('Directory Entries: ';
  for Entry := 0 to WAD_NumEntries - 1 Do Begin
    WAD_ReadEntry (Entry, Start, Length, EntryName;
  Write (TT_PadString (EntryName, 10));
  end;

  WriteLn ('Display which title?';
  Write (': ';
  ReadLn (WhichEntry;
  if WhichEntry = '' Then
  Halt;

  Mode13h.Init;
  WAD_ReadEntry (WAD_FindEntry ('PLAYPAL'), Start, Length, EntryName;
  WAD_ReadEntryData (Start, Length, @RawPalette;
  WAD_ReadEntry (WAD_FindEntry (WhichEntry), Start, Length, EntryName;
  WAD_ReadEntryData (Start, Length, @RawTexture;
  WAD_SetPalette (@RawPalette [6145]);
{  WAD_DisplayTile (RawTexture);}
  WAD_DisplaySprite (RawTexture;
  for Entry := 8 downto 0 Do Begin
    Mode13h. WaitRetrace;
    WAD_SetPalette (@RawPalette [768 * Entry+ 1]);
    Delay (20;

  end;
  repeat until KeyPressed;
  TextMode (LastMode;
end.
***

Now you need my boring Mode13h unit:

*** C:\TP\WORK\MODE13H.PAS
unit Mode13h;

Interface

Procedure GetCol(C : Byte; var R, G, B : Byte;
procedure SetCol(C, R, G, B : Byte;
procedure Init;
procedure PlotPixel (X, Y: Word; Color: Byte;
procedure WaitRetrace;

Implementation

Const PelAddrRgR  = $3C7;
      PelAddrRgW  = $3C8;
      PelDataReg  = $3C9;

procedure GetCol(C : Byte; var R, G, B : Byte;
Begin
   Port[PelAddrRgR] := C;
   R := Port[PelDataReg];
   G := Port[PelDataReg];
   B := Port[PelDataReg];
end;

procedure SetCol(C, R, G, B : Byte;
Begin
   Port[PelAddrRgW] := C;
   Port[PelDataReg] := R;
   Port[PelDataReg] := G;
   Port[PelDataReg] := B;
end;

procedure Init; assembler;
Asm
mov ax, 13h
  int 10h
end;

procedure PlotPixel (X, Y: Word; Color: Byte); assembler;
Asm
push es
  push di
  mov ax, Y
  mov bx, ax
  shl ax, 8
  shl bx, 6
  add ax, bx
  add ax, X
  mov di, ax
  mov ax, 0A000h
  mov es, ax
  mov al, Color
  mov es:[di], al
  pop di
  pop es
End;

Procedure WaitRetrace; Assembler;
Asm;
  mov     dx, 03DAh
@@WaitRetrace_LoopA:
  in      al, dx
  and     al, 08h
  jnz     @@WaitRetrace_LoopA
@@WaitRetrace_LoopB:
  in      al, dx
  and     al, 08h
  jz      @@WaitRetrace_LoopB
End;

Begin
End.