home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / pcxview.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-28  |  3KB  |  138 lines
  1. {$i-}
  2.  
  3. program pcx_view;
  4.  
  5. uses
  6.   crt;
  7.  
  8. const
  9.   gseg : word = $a000;
  10.  
  11. type
  12.   pcxheader = record
  13.     manufacturer,version,encoding,bits_per_pixel : byte;
  14.     xmin,ymin,xmax,ymax,hres,vres : word;
  15.     palette : array[0..47] of byte;
  16.     reserved : byte;
  17.     color_planes : byte;
  18.     bytes_per_line : word;
  19.     palette_type : word;
  20.     filler : array[0..57] of byte;
  21.   end;
  22.  
  23. var
  24.   pcxfile : file;
  25.   header : pcxheader;
  26.  
  27. {----------------------------------------------------------------------------}
  28.  
  29. procedure error(errstr : string);
  30. begin
  31.   writeln(errstr);
  32.   halt;
  33. end;
  34.  
  35. {----------------------------------------------------------------------------}
  36.  
  37. function validpcx : boolean;
  38. begin
  39.   seek(pcxfile,0);
  40.   blockread(pcxfile,header,sizeof(header));
  41.   with header do validpcx := (manufacturer = 10) and (version = 5) and
  42.     (bits_per_pixel = 8) and (color_planes = 1);
  43. end;
  44.  
  45. {----------------------------------------------------------------------------}
  46.  
  47. function validpal : boolean;
  48. var v : byte;
  49. begin
  50.   seek(pcxfile,filesize(pcxfile)-769);
  51.   blockread(pcxfile,v,1);
  52.   validpal := v = $0c;
  53. end;
  54.  
  55. {----------------------------------------------------------------------------}
  56.  
  57. procedure setvideo(md : word); assembler;
  58. asm
  59.   mov ax,md
  60.   int 10h
  61. end;
  62.  
  63. {----------------------------------------------------------------------------}
  64.  
  65. procedure setpal;
  66. var pal : array[0..767] of byte;
  67. begin
  68.   seek(pcxfile,filesize(pcxfile)-768);
  69.   blockread(pcxfile,pal,768);
  70.   asm
  71.     cld
  72.     xor di,di
  73.     xor bx,bx
  74.    @L1:
  75.     mov dx,03c8h
  76.     mov ax,bx
  77.     out dx,al
  78.     inc dx
  79.     mov cx,3
  80.    @L2:
  81.     mov al,byte ptr pal[di]
  82.     shr al,1
  83.     shr al,1
  84.     out dx,al
  85.     inc di
  86.     loop @L2
  87.     inc bx
  88.     cmp bx,256
  89.     jne @L1
  90.   end;
  91. end;
  92.  
  93. {----------------------------------------------------------------------------}
  94.  
  95. procedure unpack;
  96. var gofs,j : word; i,k,v,loop : byte;
  97. begin
  98.   seek(pcxfile,128);
  99.   gofs := 0;
  100.   for i := 0 to header.ymax-header.ymin+1 do begin
  101.     j := 0;
  102.     while j < header.bytes_per_line do begin
  103.       blockread(pcxfile,v,1);
  104.       if (v and 192) = 192 then begin
  105.         loop := v and 63;
  106.         inc(j,loop);
  107.         blockread(pcxfile,v,1);
  108.         for k := 1 to loop do begin
  109.           mem[gseg:gofs] := v;
  110.           inc(gofs);
  111.         end;
  112.       end
  113.       else begin
  114.         mem[gseg:gofs] := v;
  115.         inc(gofs);
  116.         inc(j);
  117.       end;
  118.     end;
  119.   end;
  120. end;
  121.  
  122. {----------------------------------------------------------------------------}
  123.  
  124. begin
  125.   if paramstr(1) = '' then error('Enter filename on commandline.');
  126.   assign(pcxfile,paramstr(1));
  127.   reset(pcxfile,1);
  128.   if ioresult <> 0 then error(paramstr(1)+' not found.');
  129.   if not validpcx then error('Not a 256 color PCX file.');
  130.   if not validpal then error('Palette corrupt.');
  131.   setvideo($13);
  132.   setpal;
  133.   unpack;
  134.   repeat until keypressed; while keypressed do readkey;
  135.   setvideo(3);
  136.   close(pcxfile);
  137. end.
  138.