unit pcx;
INTERFACE
uses CRT,GRAF256,DOS;


PROCEDURE LOADPCX256 (fichero:string);


{--------------------------------------------------------------------------}
IMPLEMENTATION
const
    buffsize = 65521;   { Largest possible }
type
    RGBrec = record
                   redval, greenval, blueval: byte;
                 end;

var
        pcxfilename: pathstr;
        file_error: boolean;
        RGBpal: array[0..15] of RGBrec;
        RGB256: array[0..255] of RGBrec;
        {page_addr: word;}
        bytes_per_line: word;
        buff0, buff1: pointer;
        blackpal: array[0..255] of RGBrec;
        scratch, abuff0, abuff1: pointer;
        is_CGA, is_VGA: boolean;
        repeatcount: byte;
        datalength: word;
        columncount, plane, video_index: word;
        regs: registers;

{ ----------------------------------------------------------------------- }
procedure SETREGISTERS(var palrec);

{ Palrec is any string of 768 bytes containing the RGB data. }

begin
regs.ah:= $10;               { BIOS color register function }
regs.al:= $12;               { Subfunction }
regs.es:= seg(palrec);       { Address of palette info. }
regs.dx:= ofs(palrec);
regs.bx:= 0;                 { First register to change }
regs.cx:= $100;              { Number of registers to change }
intr($10, regs);             { Call BIOS }
end;
{ ----------------------------------------------------------------------- }
{ ========================= 256-color files ============================= }

procedure DECODE_PCX256; assembler;

(* Registers used:

   AL   data byte to be written to video
   BX   end of input buffer
   CL   number of times data byte is to be written
   ES   output segment
   DI   index into output buffer
   DS   segment of input buffer
   SI   index into input buffer
*)

asm
mov     es, donde       { video segment }
mov     di, video_index     { index into video }
xor     cx, cx              { clean up loop counter }
mov     cl, repeatcount     { count in CL }
mov     bx, datalength      { end of input buffer }
push    ds                  { save DS }
lds     si, scratch         { pointer to input in DS:SI }
add     bx, si              { adjust datalength - SI may not be 0 }
cld                         { clear DF }
cmp     cl, 0               { was last byte a count? }
jne     @multi_data         { yes, so next is data }

{ --------------------- Loop through input buffer ----------------------- }

@getbyte:                   { last byte was not a count }
cmp     si, bx              { end of input buffer? }
je      @exit               { yes, quit }
lodsb                       { get byte into AL, increment SI }
cmp     al, 192             { test high bits }
jb      @one_data           { not set, not a count }
{ It's a count byte }
xor     al, 192             { get count from 6 low bits }
mov     cl, al              { store repeat count }
cmp     si, bx              { end of input buffer? }
je      @exit               { yes, quit }
@multi_data:
lodsb                       { get byte into AL, increment SI }
rep     stosb               { write byte CX times }
jmp     @getbyte
@one_data:
stosb                       { byte into video }
jmp     @getbyte

{ ------------------------- Finished with buffer ------------------------ }

@exit:
pop     ds                  { restore Turbo's data segment }
mov     video_index, di     { save status for next run thru buffer }
mov     repeatcount, cl
end;  { asm }

{ ================= Main procedure for 256-color files ================== }

procedure READ_PCX256(pfilename: pathstr);

var     x, gun, pcxcode: byte;
        pcxfile: file;
        palette_start, total_read: longint;
        palette_flag: byte;
        version: word;

procedure CLEANUP;

begin
close(pcxfile);
freemem(scratch, buffsize);
end;

begin    { READ_PCX256 }
assign(pcxfile, pfilename);
{$I-} reset(pcxfile, 1);  {$I+}
file_error:= (IOresult <> 0);
if file_error then exit;
getmem(scratch, buffsize);                  { Allocate scratchpad }
blockread(pcxfile, version, 2);             { Read first two bytes }
file_error:= (hi(version) < 5);             { No palette info. }
if file_error then
begin
  cleanup; exit;
end;
palette_start:= filesize(pcxfile) - 769;

seek(pcxfile, 128);                        { Scrap file header }
total_read:= 128;

repeatcount:= 0;                           { Initialize assembler vars. }
video_index:= 0;

repeat
  blockread(pcxfile, scratch^, buffsize, datalength);
  inc(total_read, datalength);
  if (total_read > palette_start) then
      dec(datalength, total_read - palette_start);
  decode_pcx256;
until (eof(pcxfile)) or (total_read>= palette_start);

(* The last 769 btes of the file are palette information, starting with a
   one-byte flag. Each group of three bytes represents the RGB values of
   one of the color registers. The values have to be divided by 4 to be
   brought within the range 0-63 expected by the registers. *)

seek(pcxfile, palette_start);
blockread(pcxfile, palette_flag, 1);
file_error:= (palette_flag <> 12);
if file_error then
begin
  cleanup; exit;
end;
blockread(pcxfile, RGB256, 768);         { Get palette info. }
for x:= 0 to 255 do
with RGB256[x] do
begin
  redval:= redval shr 2;
  greenval:= greenval shr 2;
  blueval:= blueval shr 2;
end;
cleanup;
end;  { READ_PCX256 }
{ ----------------------------------------------------------------------- }
{ ----------------------------------------------------------------------- }
PROCEDURE LOADPCX256 (fichero:string);
begin
fillchar(blackpal, 768, 0);              { Pone la paleta en negro }
setregisters(blackpal);
read_pcx256(fichero);                { ... Cargar la imagen }

if file_error then
  begin
   modotexto;
   writeln('Error al leer fichero');
   halt;
  end;
setregisters(RGB256);                    { Show true colors }
end;
{ ----------------------------------------------------------------------- }
end.
