[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {
    >does anyone know the file format for a doom wad in pascal? This would
    >really be helpful for me. Thanx a lot.
    I bet you really wanted a few pages of mostly uncommented source code, right?
    And not just that, but it's pretty poorly written too :)

    }
    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 Begi
            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.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]