Contributor: DAVID O'SHEA
{>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 = 3ドルC7;
PelAddrRgW = 3ドルC8;
PelDataReg = 3ドルC9;
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.