home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / pcx2.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-05  |  3KB  |  121 lines
  1. {
  2.         For all those Pascal programmers who just want something simple
  3.         to display a 320x200x256 colour PCX file on the screen here it is.
  4.         This was a direct translation from the C source code of PCXVIEW
  5.         written by Lee Hamel (Patch), Avalanche coder.  I removed the
  6.         inline assembly code so that you beginners can see what was going
  7.         on behind those routines.
  8.  
  9.                                                       Norman Yen
  10.                                                       Infinite Dreams BBS
  11.                                                       August 11, 1993
  12. }
  13.  
  14. type pcxheader_rec=record
  15.      manufacturer: byte;
  16.      version: byte;
  17.      encoding: byte;
  18.      bits_per_pixel: byte;
  19.      xmin, ymin: word;
  20.      xmax, ymax: word;
  21.      hres: word;
  22.      vres: word;
  23.      palette: array [0..47] of byte;
  24.      reserved: byte;
  25.      colour_planes: byte;
  26.      bytes_per_line: word;
  27.      palette_type: word;
  28.      filler: array [0..57] of byte;
  29.      end;
  30.  
  31. var header: pcxheader_rec;
  32.     width, depth: word;
  33.     bytes: word;
  34.     palette: array [0..767] of byte;
  35.     f: file;
  36.     c: byte;
  37.  
  38. procedure Read_PCX_Line(vidoffset: word);
  39. var c, run: byte;
  40.     n: integer;
  41.     w: word;
  42. begin
  43.   n:=0;
  44.   while (n < bytes) do
  45.   begin
  46.     blockread (f, c, 1);
  47.  
  48.     { if it's a run of bytes field }
  49.     if ((c and 192)=192) then
  50.     begin
  51.  
  52.       { and off the high bits }
  53.       run:=c and 63;
  54.  
  55.       { get the run byte }
  56.       blockread (f, c, 1);
  57.       n:=n+run;
  58.       for w:=0 to run-1 do
  59.       begin
  60.         mem [$a000:vidoffset]:=c;
  61.         inc (vidoffset);
  62.       end;
  63.     end else
  64.     begin
  65.       n:=n+1;
  66.       mem [$a000:vidoffset]:=c;
  67.       inc (vidoffset);
  68.     end;
  69.   end;
  70. end;
  71.  
  72. procedure Unpack_PCX_File;
  73. var i: integer;
  74. begin
  75.   for i:=0 to 767 do
  76.     palette [i]:=palette [i] shr 2;
  77.   asm
  78.     mov ax,13h
  79.     int 10h
  80.     mov ax,1012h
  81.     xor bx,bx
  82.     mov cx,256
  83.     mov dx,offset palette
  84.     int 10h
  85.   end;
  86.   for i:=0 to depth-1 do
  87.     Read_PCX_Line (i*320);
  88.   asm
  89.  
  90.     xor ax,ax
  91.     int 16h
  92.     mov ax,03h
  93.     int 10h
  94.   end;
  95. end;
  96.  
  97. begin
  98.   if (paramcount > 0) then
  99.   begin
  100.     assign (f, paramstr (1));
  101.     reset (f,1);
  102.     blockread (f, header, sizeof (header));
  103.     if (header.manufacturer=10) and (header.version=5) and
  104.        (header.bits_per_pixel=8) and (header.colour_planes=1) then
  105.     begin
  106.       seek (f, filesize (f)-769);
  107.       blockread (f, c, 1);
  108.       if (c=12) then
  109.       begin
  110.         blockread (f, palette, 768);
  111.         seek (f, 128);
  112.         width:=header.xmax-header.xmin+1;
  113.         depth:=header.ymax-header.ymin+1;
  114.         bytes:=header.bytes_per_line;
  115.         Unpack_PCX_File;
  116.       end else writeln ('Error reading palette.');
  117.     end else writeln ('Not a 256 colour PCX file.');
  118.     close (f);
  119.   end else writeln ('No file name specified.');
  120. end.
  121.