[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]
{ ---RLTGA.PAS--- The Run-Length Encoded Targa (type 9) viewer for DOS ---}
{ ===Coded by Patrick O'Malley=== }
{ ---Is this OK for SWAG?--- }
{ ===Please mention me if you use this proggy in one of your proggys=== }
{ ---Sorry about the lack of comments. I did add _some_ tho ;)--- }
{ ---My InterNet E-Mail address is: d005530c@dcfreenet.seflin.lib.fl.us---}
{ Just a small note about the strange stuff at the end of the proggy:
That virtual screen that is written to is used to flip the TGA around.
These TGAs are encoded bottom-up. Since I can't read the file from
bottom up, I must flip the file around after it has been read. }
{$X+}
Program Read_Encoded_TGA;
Uses Crt;
Type TGAHeader = record
IDFieldLength : Byte;
ColorMapType : Byte;
ImageType : Byte;
CMapOrigin : Integer;
CMapLength : Integer;
CMapSize : Byte;
XOrigin : Integer;
YOrigin : Integer;
Width : Integer;
Height : Integer;
ImagePixSize : Byte;
ImageDescriptor : Byte;
end;
ImageIDFieldType = Array[1..256] of byte;
Const VGA = $A000;
Var Header : TGAHeader;
ImageIDField : ImageIDFieldType;
TGA : File;
TGAName : String;
VGAScreen : Pointer;
VGASeg : Word;
Pal : Array[0..255,0..2] of byte;
Counter,Count : Word;
Temp : Byte;
PixelCount : Word;
Rep : Byte;
NewByte : Byte;
MaxPix : Word;
Procedure SetColor(Col, R, G, B : Byte);
Begin
Asm
mov dx, 3c8h
mov al, [Col]
out dx, al
inc dx
mov al, [R]
out dx, al
mov al, [G]
out dx, al
mov al, [B]
out dx, al
End;
End; {SetColor}
Procedure SetMcga;
Begin
Asm
mov ax, 0013h
int 10h
End;
End; {SetMCGA}
Procedure SetText;
Begin
Asm
mov ax, 0003h
int 10h
End;
End; {SetText}
Procedure Error(Str : String);
Begin
writeln(Str);
Halt(1);
End;
Begin
TGAName := Paramstr(1);
If TGAName = '' then Error('Enter filename on Command Line.');
{$I-}
Assign(TGA,TGAName);
Reset(TGA,1);
IF IOResult <> 0 then Error('File not found!');
{$I+}
BlockRead(TGA,Header,SizeOf(Header));
{This next part checks for an image ID field (header.IDFieldLength > 0)
then, if one is found, reads it into ImageIDField. Should be less than
256 bytes (let's hope). It is usually omitted (header.IDFieldLength=0).}
If Header.IDFieldLength > 0 then
BlockRead(TGA,ImageIDField,Header.IDFieldLength);
{Make sure that it is an encoded type 9 TGA}
If Header.ImageType <> 9 then Begin
Close(TGA);
Error('Not a color-mapped type-9 Targa!');
End;
SetMCGA;
{Read colors}
For Counter := 0 to Header.CMapLength-1 do
For Count := 0 to 2 do Begin
BlockRead(TGA,Temp,1);
Pal[Counter,Count] := Temp shr 2;
End;
{Set colors}
For Counter := 0 to 255 do
SetColor(Counter,Pal[Counter,2],Pal[Counter,1],Pal[Counter,0]);
{Read image stuff!}
MaxPix := (Header.Height*Header.Width);
PixelCount := 0;
GetMem(VGAScreen,64000);
VGASeg := Seg(VGAScreen^);
FillChar(Mem[VGASeg:0],64000,0);
Repeat
BlockRead(TGA,Temp,1);
If Temp shr 7 = 1 then begin
BlockRead(TGA,NewByte,1);
Rep := Temp AND 127;
For Count := 1 to rep+1 do begin
Mem[VGASeg:PixelCount] := NewByte;
Inc(PixelCount);
End;
end
else
Begin
Rep := Temp AND 127;
For Count := 1 to Rep+1 do Begin
BlockRead(TGA,NewByte,1);
Mem[VGASeg:PixelCount] := NewByte;
Inc(PixelCount);
End;
End;
Until PixelCount = MaxPix;
{Flip the screen onto the display}
For Count := 0 to Header.Width-1 do {x}
For Counter := 0 to Header.Height-1 do {y}
Mem[VGA:Counter*320+Count] :=
Mem[VGASeg:((Header.Height-1)-Counter)*Header.Width+Count]; Readkey;
Close(TGA);
Freemem(VGAScreen,64000);
SetText;
End.
[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]