{ show_pcx.pas                          Copyright (c) Petr Masopust  }
{ Unit pre hru pyramida.pas                                          }
{ Nacita PCX subor do pamete a zobrazi na obrazovke.                 }
{                                                                    }
{ Datum:03.09.2018                              http://www.trsek.com }
{$R-}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$I+}    {I/O checking on}
{$N-}    {No numeric coprocessor}
unit show_pcx;
interface
type obrazovka=array[0..199,0..319] of byte;
     pobrazovka=^obrazovka;
procedure read_pcx(name:string;p:pointer);
implementation
{****************************************************************************}
{                                                                            }
{ SHOW_PCX is an example program written in Borland's Turbo Pascal(R) 5.0.   }
{ (Turbo Pascal is a registered trademark of Borland International, Inc.)    }
{ SHOW_PCX doesn't use any of the graphics routines built into Turbo Pascal, }
{ since many programmers won't be using Pascal for their final program.      }
{                                                                            }
{                            PERMISSION TO COPY:                             }
{                                                                            }
{          SHOW_PCX -- (C) Copyright 1989 ZSoft, Corporation.                }
{                                                                            }
{ You are licensed to freely copy SHOW_PCX and incorporate it into your      }
{ own programs, provided that:                                               }
{                                                                            }
{  IF YOU COPY SHOW_PCX WITHOUT CHANGING IT:                                 }
{  (1) You must retain this "Permission to Copy" notice, and                 }
{  (2) You must not charge for the SHOW_PCX software or                      }
{      documentation; however, you may charge a service fee for              }
{      disk duplication and distribution, so long as such fee is             }
{      not more than $5.00.                                                  }
{                                                                            }
{  IF YOU MODIFY SHOW_PCX AND/OR INCORPORATE SHOW_PCX INTO YOUR OWN PROGRAMS }
{  (1) You must include the following acknowledgment notice in the           }
{      appropriate places:                                                   }
{                                                                            }
{      Includes portions of SHOW_PCX.                                        }
{      Used by permission of ZSoft Corporation.                              }
{                                                                            }
{                                                                            }
{ ZSoft Corporation reserves all rights to SHOW_PCX except as stated herein. }
{                                                                            }
{                                                                            }
{                  [END OF "PERMISSION TO COPY" NOTICE]                      }
{                                                                            }
{ This program reads a PC Paintbrush PCX file and shows it on the screen.    }
{ The picture must be a 2 color CGA, 4 color CGA, or a 16 color EGA picture. }
{ The picture will be displayed until a key is pressed.                      }
{                                                                            }
{ This program can be run at the DOS prompt - 'SHOW_PCX SAMPLE.PCX'.         }
{                                                                            }
{****************************************************************************}
{                                                                            }
{ Since this program is provided as a service, you are on your own when      }
{ when you modify it to work with your own programs.                         }
{                                                                            }
{ We strive to make every program bug-free. If you find any bugs in this     }
{ program, please contact us on Compuserve (76702,1207)                      }
{ However, this program is provided AS IS and we are not responsible for any }
{ problems you might discover.                                               }
{                                                                            }
{****************************************************************************}
{                                                                            }
{ Remember, some computers and video adapters are NOT 100% compatible, no    }
{ matter what their marketing department may say. This shows up when your    }
{ program runs on everyone's computer EXCEPT a particular clone.             }
{ Unfortunately, there is not much you can do to correct it.                 }
{                                                                            }
{ For example, some early VGA cards do not support the BIOS calls to set up  }
{ a VGA palette - so the PCX image may come up all black, or with the wrong  }
{ colors.                                                                    }
{                                                                            }
{ Also, if you use code that attempts to determine what kind of video card   }
{ is attached to the computer it may lock-up...                              }
{                                                                            }
{****************************************************************************}
{                                                                            }
{ The PCX file format was originally developed in 1982, when there were only }
{ three video addapters: CGA, Hercules, and the Tecmar Graphics Master. Over }
{ the years, as new hardware became available (EGA, VGA, etc.), we had to    }
{ modify the format. Wherever posible, we insure downward compatiblity. This }
{ means, if you follow the suggestions in this program, your own program     }
{ should be able to read 'new' PCX files in the future.                      }
{                                                                            }
{****************************************************************************}

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{
  NEEDED ADDITIONS:
  CGA palette - read old and new palette - set screen palette
}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}


uses
  Crt, Dos;

const
   MAX_WIDTH = 4000;    { arbitrary - maximum width (in bytes) of a PCX image }
   COMPRESS_NUM = $C0;  { this is the upper two bits that indicate a count }
   MAX_BLOCK = 4096;

   RED = 0;
   GREEN = 1;
   BLUE = 2;

   CGA4 = $04;          { video modes }
   CGA2 = $06;
   EGA  = $10;
   VGA  = $12;
   MCGA = $13;

type
   str80 = string [80];
   file_buffer = array [0..127] of byte;
   block_array = array [0..MAX_BLOCK] of byte;
   pal_array = array [0..255, RED..BLUE] of byte;
   ega_array = array [0..16] of byte;
   line_array = array [0..MAX_WIDTH] of byte;

   pcx_header = record
        Manufacturer: byte;     { Always 10 for PCX file }

        Version: byte;          { 2 - old PCX - no palette (not used anymore),
                                  3 - no palette,
                                  4 - Microsoft Windows - no palette (only in
                                      old files, new Windows version uses 3),
                                  5 - with palette }

        Encoding: byte;         { 1 is PCX, it is possible that we may add
                                  additional encoding methods in the future }

        Bits_per_pixel: byte;   { Number of bits to represent a pixel
                                  (per plane) - 1, 2, 4, or 8 }

        Xmin: integer;          { Image window dimensions (inclusive) }
        Ymin: integer;          { Xmin, Ymin are usually zero (not always) }
        Xmax: integer;
        Ymax: integer;

        Hdpi: integer;          { Resolution of image (dots per inch) }
        Vdpi: integer;          { Set to scanner resolution - 300 is default }

        ColorMap: array [0..15, RED..BLUE] of byte;
                                { RGB palette data (16 colors or less)
                                  256 color palette is appended to end of file }

        Reserved: byte;         { (used to contain video mode)
                                  now it is ignored - just set to zero }

        Nplanes: byte;          { Number of planes }

        Bytes_per_line_per_plane: integer;   { Number of bytes to allocate
                                               for a scanline plane.
                                               MUST be an an EVEN number!
                                               Do NOT calculate from Xmax-Xmin! }

        PaletteInfo: integer;   { 1 = black & white or color image,
                                  2 = grayscale image - ignored in PB4, PB4+
                                  palette must also be set to shades of gray! }

        HscreenSize: integer;   { added for PC Paintbrush IV Plus ver 1.0,  }
        VscreenSize: integer;   { PC Paintbrush IV ver 1.02 (and later)     }
                                { I know it is tempting to use these fields
                                  to determine what video mode should be used
                                  to display the image - but it is NOT
                                  recommended since the fields will probably
                                  just contain garbage. It is better to have
                                  the user install for the graphics mode he
                                  wants to use... }

        Filler: array [74..127] of byte;     { Just set to zeros }
        end;

var
   Name: str80;                        { Name of PCX file to load }
   ImageName: str80;                   { Name of PCX file - used by ReadError }
   BlockFile: file;                    { file for reading block data }
   BlockData: block_array;             { 4k data buffer }

   Header: pcx_header;                 { PCX file header }
   Palette256: pal_array;              { place to put 256 color palette }
   PaletteEGA: ega_array;              { place to put 17 EGA palette values }
   PCXline: line_array;                { place to put uncompressed data }

   Ymax: integer;                      { maximum Y value on screen }
   NextByte: integer;                  { index into file buffer in ReadByte }
   Index: integer;                     { PCXline index - where to put Data }
   Data: byte;                         { PCX compressed data byte }

   PictureMode: integer;               { Graphics mode number }
   Reg: Registers;                     { Register set - used for int 10 calls }


{ ================================= Error ================================== }

procedure Error (s: str80 );

{ Print out the error message and wait, then halt }

var c: char;
    i: integer;

begin
TextMode (C80);
writeln ('ERROR');
writeln (s);
halt;
end;   { Error }


{ =============================== ReadError =============================== }

procedure ReadError (msg: integer);

{ Check for an i/o error }

begin
if IOresult <> 0 then
   case msg of
   1: Error ('Nemohu otevrit soubor s obrazkem pozadi !');
   2: Error ('Nemohu uzavrit soubor s obrazkem pozadi - disk muze byt zaplnen.');
   3: Error ('Chyba pri nacitani souboru s obrazkem pozadi !');

   else
      Error ('Chyba pri praci s obrazkem pozadi !');
   end;   { case }
end;   { ReadError }


{ =========================== VideoMode =============================== }

procedure gwrite(s: string;cp,cz,x,y: byte);
var j,c : byte;
begin
  for j:=1 to length(s) do begin
    c:=ord(s[j]);
    asm
      mov ah,2
      mov bh,0
      mov dh,y
      mov dl,x
      int 10h
      mov ah,9
      mov al,c
      mov bh,cp
      mov bl,cz
      mov cx,1
      int 10h
    end;
    inc(x);
  end;
end;


procedure VideoMode (n: integer);

{ Do a BIOS call to set the video mode }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }

begin
Reg.ah := $00;
Reg.al := n;                         { mode number }
intr ($10, Reg);                     { call interrupt }
gwrite('Nacitam data ...',0,2,12,10);
end;  { VideoMode }


{ =========================== VGApalette =============================== }

procedure VGApalette (n, R, G, B: integer);

{ Set a single VGA palette and DAC register pair.
  n is the index of the palette register.
  R, G, and B are 0..255. }

{ This code is never called - it is here as an example }

{ In Turbo Pascal, a '$' means the number is hexadeximal. }

begin
R := R shr 2;                        { R, G, and B are now 0..63 }
G := G shr 2;
B := B shr 2;

Reg.ah := $10;                       { Set Palette Call }
Reg.al := $0;                        { set individual palette register }
Reg.bl := n;                         { palette register number 0..15, 0..255 }
Reg.bh := n;                         { palette register value }
intr ($10, Reg);                     { call interrupt }

Reg.ah := $10;                       { Set DAC Call }
Reg.al := $10;                       { set individual DAC register }
Reg.bx := n;                         { DAC register number 0..15, 0..255 }
Reg.dh := R;                         { red value 0..63 }
Reg.ch := G;                         { green value 0..63 }
Reg.cl := B;                         { blue value 0..63 }
intr ($10, Reg);                     { call interrupt }
end;  { VGApalette }

{ =========================== EntireVGApalette =============================== }

procedure EntireVGApalette;

{ Set the VGA's entire 256 color palette. }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }

var
   i: integer;

begin
for i := 0 to 255 do
   begin                                          { R, G, and B must be 0..63 }
   Palette256 [i, RED]   := Palette256 [i, RED]   shr 2;
   Palette256 [i, GREEN] := Palette256 [i, GREEN] shr 2;
   Palette256 [i, BLUE]  := Palette256 [i, BLUE]  shr 2;
   end;

Reg.ah := $10;                       { Set DAC Call }
Reg.al := $12;                       { set a block of DAC registers }
Reg.bx := 0;                         { first DAC register number }
Reg.cx := 255;                       { number of registers to update }
Reg.dx := ofs (Palette256);          { offset of block }
Reg.es := seg (Palette256);          { segment of block }
intr ($10, Reg);                     { call interrupt }

end;  { EntireVGApalette }


{ =========================== SetPalette =============================== }

procedure SetPalette;

{ Set up the entire graphics palette }

var i: integer;

begin
if PictureMode = MCGA then
   EntireVGApalette
else error('Vadny obrazek s pozadim !');
end;  { SetPalette }

{ =========================== ShowMCGA =============================== }

procedure ShowMCGA (Y: integer;p:pobrazovka);

{ Put a line of MCGA data on the screen }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }

var
   l: integer;

begin
l := Header.XMax - Header.Xmin;            { compute number of bytes to display }
if l > 320 then
   l := 320;                               { don't overrun screen width }

Move (PCXline [0], p^[y,0], l+1);

end;   { ShowMCGA }


{ =========================== Read256palette =============================== }

procedure Read256palette;

{ Read in a 256 color palette at end of PCX file }

var
   i: integer;
   b: byte;

begin
seek (BlockFile, FileSize (BlockFile) - 769);
BlockRead (BlockFile, b, 1);           { read indicator byte }
ReadError (3);

if b <> 12 then                        { no palette here... }
   exit;

BlockRead (BlockFile, Palette256, 3*256);
ReadError (3);

seek (BlockFile, 128);                 { go back to start of PCX data }

end;  { Read256palette }


{ =========================== ReadHeader =============================== }

procedure ReadHeader;

{ Load a picture header from a PC Paintbrush PCX file }

label WrongFormat;

begin
{$I-}
BlockRead (BlockFile, Header, 128);         { read 128 byte PCX header }
ReadError (3);

                                            { Is it a PCX file? }
if (Header.Manufacturer <> 10) or (Header.Encoding <> 1) then
   begin
   close (BlockFile);
   Error ('Chybny obrazek s pozadim !');
   end;

if (Header.Nplanes = 1) then
   begin
   Ymax := 199;

   if (Header.Bits_per_pixel = 8) then
      begin
      PictureMode := MCGA;
      if Header.Version = 5 then
         Read256palette;
      end
   else
      goto WrongFormat;
   end
else
   begin
WrongFormat:
   close (BlockFile);
   Error ('Vadny soubor s obrazkem pozadi !');
   end;

Index := 0;
NextByte := MAX_BLOCK;          { indicates no data read in yet... }

end;  { ReadHeader }


{ =========================== ReadByte =============================== }

procedure ReadByte;

{ read a single byte of data - use BlockRead because it is FAST! }

var
   NumBlocksRead: integer;

begin
if NextByte = MAX_BLOCK then
   begin
   BlockRead (BlockFile, BlockData, MAX_BLOCK, NumBlocksRead);
   NextByte := 0;
   end;

data := BlockData [NextByte];
inc (NextByte);                         { NextByte++; }
end;  { ReadByte }


{ =========================== Read_PCX_Line =============================== }

procedure Read_PCX_Line;

{ Read a line from a PC Paintbrush PCX file }

var
   count: integer;
   bytes_per_line: integer;

begin
{$I-}

bytes_per_line := Header.Bytes_per_line_per_plane * Header.Nplanes;

                          { bring in any data that wrapped from previous line }
                          { usually none  -  this is just to be safe          }
if Index <> 0 then
   FillChar (PCXline [0], Index, data);    { fills a contiguous block of data }

while (Index < bytes_per_line) do          { read 1 line of data (all planes) }
   begin
   ReadByte;

   if (data and $C0) = compress_num then
      begin
      count := data and $3F;
      ReadByte;
      FillChar (PCXline [Index], count, data);  { fills a contiguous block }
      inc (Index, count);                       { Index += count; }
      end
   else
      begin
      PCXline [Index] := data;
      inc (Index);                              { Index++; }
      end;
   end;

ReadError (3);

Index := Index - bytes_per_line;

{$I+}
end;  { Read_PCX_Line }


{ =========================== Read_PCX =============================== }

procedure Read_PCX (name: string;p:pointer);

{ Read PC Paintbrush PCX file and put it on the screen }

var
   k, kmax: integer;

begin
{$I-}
ImageName := name;                     { used by ReadError }

assign (BlockFile, name);
reset (BlockFile, 1);                  { use 1 byte blocks }
ReadError (1);

ReadHeader;                            { read the PCX header }

{ >>>>> No checking is done to see if the user has the correct hardware <<<<<
  >>>>> to load the image. Your program sure verify the video mode is   <<<<<
  >>>>> supported. Otherwise, the computer may lock-up.                 <<<<< }

VideoMode (PictureMode);               { switch to graphics mode }
if Header.Version = 5 then
   SetPalette;                         { set the screen palette, if available }

{ >>>>> Note: You should compute the height of the image as follows. <<<<<
  >>>>> Do NOT just read until End-Of-File!                          <<<<< }

kmax := Header.Ymin + Ymax;
if Header.Ymax < kmax then        { don't show more than the screen can display }
   kmax := Header.ymax;

if (PictureMode = MCGA) then
   begin
   for k := Header.Ymin to kmax do
      begin
      Read_PCX_Line;
      ShowMCGA (k,p);
      end;
   end
else error('Vadny obrazek s pozadim !');                                       { it's a CGA picture }

close (BlockFile);
ReadError (2);
{$I+}
end;  { Read_PCX }

end.  { Show_PCX }