Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : PCX.PAS

 
Output of file : PCX.PAS contained in archive : 3DLAB110.ZIP
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄPCX-file viewer, 256 colors only.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+}

UNIT PCX;

INTERFACE

PROCEDURE InitPCX( BytesPerRow : Word; ScreenPtr : Pointer );
PROCEDURE LoadPCX( CONST f : STRING; X, Y : Word; PC : Boolean );

IMPLEMENTATION

USES VGAPal,
BinFiles,
Error,
AsmSys;

TYPE BytePtr = ^Byte;

PtrTYPE = RECORD
Ofs : Word;
Seg : Word;
END;

VAR BPR : Word;
ScrOfs : Word;
ScrSeg : Word;
ScrPtr : BytePtr;

CurrPos : BytePtr;

PROCEDURE SetPix( x, y : Word; color : Byte );
BEGIN
BytePtr( Ptr( ScrSeg, ScrOfs + y * BPR + x ))^ := color
END;

PROCEDURE HorizLine( x0, x1, y : Word; color : Byte );
BEGIN
IF x0 > x1 THEN SwapInt( x0, x1 );
FillCharFast( Ptr( ScrSeg, ScrOfs + y * BPR + x0 )^, x1 - x0, color )
END;

{ Load file f, to position X, Y. If PC = TRUE, load the palette too }

PROCEDURE LoadPCX( CONST f : STRING; X, Y : Word; PC : Boolean );
TYPE PCXFile = RECORD
CASE Word OF
0 : ( Id0 : Byte;
d0 : Word;
Id1 : Byte;
x0 : Word;
y0 : Word;
x1 : Word;
y1 : Word );
1 : ( d : ARRAY[ 0..2047 ] OF Byte )
END;

VAR q : FILE;
b : PCXFile;
BytesRead, pos, w, h, eX, eY, n : Word;
cb : Byte;

{ Only 256-color files }

FUNCTION ValidFile : Boolean;
BEGIN
BlockRead( q, b, 128, BytesRead );
IF ( b.Id0 <> 10 ) OR ( b.Id1 <> 8 ) THEN
BEGIN
Close( q );
ValidFile := FALSE
END
ELSE
ValidFile := TRUE
END;

{ Set the palette registers }

PROCEDURE SetPCXPal;
VAR i : Word;
BEGIN
Seek( q, FileSize( q ) - 3 * 256 - 1 );
BlockRead( q, b, 3 * 256 + 1 );
IF b.Id0 = 12 THEN
BEGIN
FOR i := 1 TO 3 * 256 + 1 DO b.d[ i ] := b.d[ i ] SHR 2;
SetDACs( 0, 256, @b.d[ 1 ] )
END
END;
{ PCX-file is coded as follows:

- If two hi bits in the byte = 0 --> this is the pixel color
- If two hi bits in the byte = 1 --> six lo bits is the pixel run
length, and next byte is the color of these pixels }
BEGIN
IF NOT FOpenRead( q, f ) THEN FatalError('Cannot load file ' + f + '!');
IF NOT ValidFile THEN Exit;
w := Succ( b.x1 - b.x0 ); { width }
h := Succ( b.y1 - b.y0 ); { height }
n := 0; { run-length }
eX := X + w; { X, Y end points }
eY := Y + h;
CurrPos := BytePtr( Ptr( ScrSeg, ScrOfs + Y * BPR + X ));
REPEAT
BlockRead( q, b, 2048, BytesRead );
pos := 0;
WHILE ( pos < BytesRead ) AND ( y < eY ) DO
BEGIN
cb := b.d[ pos ];
IF n <> 0 THEN
BEGIN
HorizLine( X, X + n, Y, cb );
Inc( Word( CurrPos ), n );
Inc( X, n );
n := 0
END ELSE
IF ( cb AND $C0 ) = $C0 THEN n := cb AND $3F ELSE
BEGIN
{ SetPix( X, Y, cb ); }
CurrPos^ := cb;
Inc( Word( CurrPos ));
Inc( X )
END;
Inc( pos );
IF X >= eX THEN
BEGIN
Inc( Word( CurrPos ), BPR - w );
Dec( X, w );
Inc( Y )
END
END
UNTIL ( BytesRead = 0 ) OR ( Y >= eY );
IF PC THEN SetPCXPal;
Close( q )
END;

PROCEDURE InitPCX( BytesPerRow : Word; ScreenPtr : Pointer );
BEGIN
BPR := BytesPerRow;
ScrPtr := ScreenPtr;
ScrOfs := PtrTYPE( ScrPtr ).Ofs;
ScrSeg := PtrTYPE( ScrPtr ).Seg;
END;

END.


  3 Responses to “Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : PCX.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/