Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PCXKIT.ZIP/PCX.PAS

Pascal/Delphi Source File | 1992-01-06 | 26.3 KB | 676 lines

unit PCX;

(* version 3.0
                             by Peter Donnelly
                              1301 Ryan Street
                                Victoria BC
                               Canada V8T 4Y8

   ╒══════════════════════════════════════════════════════════════════════╕
   │    May be copied freely. If you make practical use of this unit,     │
   │         a contribution of $10 or more would be appreciated.          │
   ╘══════════════════════════════════════════════════════════════════════╛

   This is a unit to read .PCX files and put them in displayable form. The
   actual work of decoding the file and moving the data into memory is done
   in assembler. Version 6 of Turbo Pascal is required for compilation.

   The following display modes are supported:

          Mode      TP GraphMode     Resolution    Colors
          ~~~~      ~~~~~~~~~~~~     ~~~~~~~~~~    ~~~~~~
          $04       CGAC0 to C3      320 x 200         4
          $06       CGAHi            640 x 200         2
          $0D        ---             320 x 200        16
          $0E       EGALo/VGALo      640 x 200        16
          $10       EGAHi/VGAMed     640 x 350        16
          $12       VGAHi            640 x 480        16
          $13        ---             320 x 200       256

   Mode $13 is supported only for files containing palette information,
   i.e. not those produced by versions of Paintbrush earlier than 3.0.

   The unit has been optimized for speed rather than flexibility or
   compactness. In particular, the routine for displaying 16-color files
   (which require the most computation) has been improved and now runs
   about 50 percent faster than that in version 2.

   It is assumed that the image is the width of and no taller than the
   screen, and that you will set the correct display mode. No checking
   is done to see that the .PCX file is compatible with the mode you've set.
   You do, however, have to pass in the Turbo GraphDriver as a parameter
   for all but 256-color files, so that the data will be interpreted
   correctly. (For mode $0D, pass in 'EGA' or 'VGA', and see the comment on
   palettes, below.)

   For the CGA formats, the data is put into two buffers on the heap, from
   where it can be moved into the two display memory banks. See SHOWCGA for
   an example. You can of course alter the unit to move the data directly
   into display memory, but there is no great saving in time.

   For EGA and VGA formats, the data is written to page 0 of the video
   buffer. This can easily be changed by setting "page_addr" to a different
   value. Three different techniques of hiding the image while it is being
   written are demonstrated in SHOWEGA, SHOWVGA, and SHOW256. If for any
   reason you don't want to do this, you will want to rewrite the palette-
   interpretation routines as separate procedures so you can set the
   palette before decoding the image data.

   References:
   ~~~~~~~~~~
   Richard F. Ferraro, "Programmer's Guide to the EGA and VGA Cards"
   (Addison-Wesley, 1988).

   Richard Wilton, "Programmer's Guide to PC and PS/2 Video Systems"
   (Microsoft, 1987).

   "Technical Reference Manual [for Paintbrush]" (Zsoft, 1988). The
   information in this booklet is also found in a file distributed with
   at least some versions of Microsoft/PC Paintbrush.

   Software:
   ~~~~~~~~
   Besides the various incarnations of Paintbrush (ZSoft and Microsoft),
   the excellent Deluxe Paint II Enhanced (Electronic Arts) can also create
   files in .PCX format. Other graphics programs have conversion utilities.
*)

(**************************************************************************)

interface

uses
  Dos,
  Graph;

type
  RGBrec = record
             redval,
             greenval,
             blueval : byte
           end;

var
  pcxfilename : pathstr;

  file_error : boolean;

  pal : palettetype;

  RGBpal : array[0..15] of RGBrec;

  RGB256 : array[0..255] of RGBrec;

  page_addr : word;

  bytes_per_line : word;

  buff0, buff1 : pointer;

  (* CGA display memory banks: *)
  screenbuff0 : array[0..7999] of byte absolute $b800 : $0000;

  screenbuff1 : array[0..7999] of byte absolute $b800 : $2000;

const
  page0 = $A000;                   (* EGA/VGA display segment *)

 procedure SETMODE(mode : byte);
 procedure SETREGISTERS(var palrec);
 procedure READ_PCX_FILE(gdriver : integer; pfilename : pathstr);
 procedure READ_PCX256(pfilename : pathstr);

(**************************************************************************)

implementation

var
  scratch,
  abuff0,
  abuff1 : pointer;

  is_CGA,
  is_VGA : boolean;

  repeatcount : byte;

  datalength,
  columncount,
  plane,
  video_index : word;

  regs : registers;

const
  buffsize = 65521;                (* Largest possible *)

(*--------------------------- BIOS calls ---------------------------------*)

(* For modes not supported by the BGI, use SetMode to initialize the
  graphics. Since SetRGBPalette won't work if Turbo hasn't done the
  graphics initialization itself, use SetRegisters to change the colors
  in mode $13. *)

  procedure SETMODE(mode : byte);
  begin
    regs.ah := 0;                      (* BIOS set mode function *)
    regs.al := mode;                   (* Display mode *)
    intr($10, regs)                    (* Call BIOS *)
  end;

            (* Palrec is any string of 768 bytes containing the RGB data. *)
  procedure SETREGISTERS(var palrec);
  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;

(*********************** EGA/VGA 16-color files *************************)

  procedure DECODE_16; assembler;
    asm

(* Registers used:

   AL   data byte to be written to video
   AH   data bytes per scan line
   BX   end of input buffer
   CL   number of times data byte is to be written
   DL   current column in scan line
   ES   output segment
   DI   index into output buffer
   DS   segment of input buffer
   SI   index into input buffer
   BP   current video plane
*)

    push bp
    jmp @startproc

(* -------------- Procedure to write EGA/VGA image to video -------------- *)

(* The data in the .PCX file is organized by color plane, by line; that is,
  all the data for plane 0 for line 1, then for plane 1, line 1, etc.
  Writing the data to display memory is just a matter of masking out the
  other planes while one plane is being written to. This is done with the
  map mask register in the sequencer. All the other weird and wonderful
  registers in the EGA/VGA do just fine with their default settings, thank
  goodness. *)

    @writebyte :
    stosb                              (* AL into ES:DI, inc DI *)
    inc dl                             (* increment column *)
    cmp dl, ah                         (* reached end of scanline? *)
    je @doneline                       (* yes *)
    loop @writebyte                    (* no, do another *)
    ret                                (*   or get more data *)
    @doneline :
    shl bp, 1                          (* shift to next plane *)
    cmp bp, 8                          (* done 4 planes? *)
    jle @setindex                      (* no *)
    mov bp, 1                          (* yes, reset plane to 1 but don't reset index *)
    jmp @setplane
    @setindex :
    sub di, dx                         (* reset to start of line *)
    @setplane :
    push ax                            (* save AX *)
    cli                                (* no interrupts *)
    mov ax, bp                         (* plane is 1, 2, 4, or 8 *)
    mov dx, 3C5h                       (* sequencer data register *)
    out dx, al                         (* mask out 3 planes *)
    sti                                (* enable interrupts *)
    pop ax                             (* restore AX *)
    xor dx, dx                         (* reset column count *)
    loop @writebyte                    (* do it again *)
    ret                                (*   or fetch more data *)

(* ------------ Main assembler procedure for 16-color files -------------- *)

(* The first section is initialization done on each run through the input
   buffer. *)

    @startproc :
    mov bp, plane                      (* plane in BP *)
    mov es, page_addr                  (* video display segment *)
    mov di, video_index                (* index into video segment *)
    mov ah, byte ptr bytes_per_line    (* line length in AH *)
    mov dx, columncount                (* column counter *)
    mov bx, datalength                 (* no. of bytes to read *)
    xor cx, cx                         (* clean up CX for loop counter *)
    mov cl, repeatcount                (* count in CX *)
    push ds                            (* save DS *)
    lds si, scratch                    (* input buffer pointer in DS:SI *)

(* We have to adjust datalength for comparison with SI. TP 6.0 pointers are
   normalized, but the offset can still be 0 or 8. *)

    add bx, si
    cld                                (* clear DF for stosb *)

(* -------------------- Loop through input buffer ------------------------ *)

(* Here's how the data compression system works. Each byte is either image
  data or a count byte that tells how often the next image byte is repeated.
  The byte is image data if it follows a count byte, or if either of the top
  two bits is clear. Otherwise it is a count byte, with the count derived
  from the lower 6 bits. *)

    @getbyte :
    cmp si, bx                         (* end of input buffer? *)
    je @exit                           (* yes, quit *)
    lodsb                              (* get a byte from DS:SI into AL, increment SI *)
    cmp cl, 0                          (* was prev. byte a count? *)
    jg @multi_data                     (* yes, this is data *)
    cmp al, 192                        (* no, 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 *)
    jmp @getbyte                       (* go get data byte *)
    @one_data :
    mov cl, 1                          (* write byte once *)
    call @writebyte
    jmp @getbyte                       (* fetch another *)
    @multi_data :
    call @writebyte                    (* CL already set *)
    jmp @getbyte                       (* fetch another *)

(* ---------------------- Finished with buffer --------------------------- *)

    @exit :
    pop ds                             (* restore Turbo's data segment *)
    mov plane, bp                      (* save status for next run thru buffer *)
    mov repeatcount, cl
    mov columncount, dx
    mov video_index, di
    pop bp
    end;                               (* asm *)

(********************** CGA 2- and 4-color files *************************)

    procedure DECODE_CGA; assembler;
      asm

(* Registers used:

   AL   data byte to be written to video
   AH   data bytes per scan line
   BX   end of input buffer
   CL   number of times data byte is to be written
   DL   pointer to current column in screen row
   ES   output segment; temporarily used for input buffer segment
   DI   index into output buffer
   SI   index into input buffer
   BP   current video bank
*)

      push bp
      jmp @startproc

(* ------------- Procedure to store CGA image in buffers ----------------- *)

      @storebyte :
      stosb                            (* AL into ES:DI, increment DI *)
      inc dx                           (* increment column count *)
      cmp dl, ah                       (* reached end of line? *)
      je @row_ends                     (* yes *)
      loop @storebyte                  (* not end of row, do another byte *)
      ret
      @row_ends :
      xor bp, 1                        (* switch banks *)
      cmp bp, 1                        (* is bank 1? *)
      je @bank1                        (* yes *)
      mov word ptr abuff1, di          (* no, save index into bank 1 *)
      les di, abuff0                   (* bank 0 pointer into ES:DI *)
      xor dx, dx                       (* reset column counter *)
      loop @storebyte
      ret
      @bank1 :
      mov word ptr abuff0, di          (* save index into bank 0 *)
      les di, abuff1                   (* bank 1 pointer into ES:DI *)
      xor dx, dx                       (* reset column counter *)
      loop @storebyte
      ret

(* ---------------- Main assembler procedure for CGA --------------------- *)

(* It's assumed that CGA files will require only one pass through the
  input buffer. *)

      @startproc :
      mov bp, 0                        (* bank in BP *)
      mov es, word ptr abuff0[2]       (* segment of bank 0 buffer *)
      mov di, word ptr abuff0          (* offset of buffer *)
      mov ah, byte ptr bytes_per_line  (* line length in AH *)
      mov bx, datalength               (* no. of bytes to read *)
      xor cx, cx                       (* clean up CX for loop counter *)
      xor dx, dx                       (* initialize column counter *)
      mov si, dx                       (* initialize input index *)
      cld                              (* clear DF for stosb *)

(* -------------------- Loop through input buffer ------------------------ *)

      @getbyte :
      cmp si, bx                       (* end of input buffer? *)
      je @exit                         (* yes, quit *)
      push es                          (* save output pointer *)
      push di
      les di, scratch                  (* get input pointer in ES:DI *)
      add di, si                       (* add current offset *)
      mov al, [es : di]                (* get a byte *)
      inc si                           (* advance input index *)
      pop di                           (* restore output pointer *)
      pop es
      cmp cl, 0                        (* was previous byte a count? *)
      jg @multi_data                   (* yes, this is data *)
      cmp al, 192                      (* no, 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 *)
      jmp @getbyte                     (* go get data byte *)
      @one_data :
      mov cl, 1                        (* write byte once *)
      call @storebyte
      jmp @getbyte
      @multi_data :
      call @storebyte                  (* CL already set *)
      jmp @getbyte

(* ---------------------- Finished with buffer --------------------------- *)

      @exit :
      pop bp
      end;                             (* asm *)

(************* Main procedure for CGA and 16-color files ***************)

      procedure READ_PCX_FILE(gdriver : integer; pfilename : pathstr);
      type
        ptrrec = record
                   segm,
                   offs : word
                 end;

      var
        entry,
        gun,
        pcxcode,
        mask,
        colorID : byte;
        palbuf : array[0..66] of byte;
        pcxfile : file;
      begin                            (* READ_PCX_FILE *)
        is_CGA := (gdriver = CGA);     (* 2 or 4 colors *)
        is_VGA := (gdriver = VGA);     (* 16 of 256K possible colors *)
        (* Otherwise EGA - 16 of 64 possible colors *)
        assign(pcxfile, pfilename);
        {$I-}
        reset(pcxfile, 1);
        {$I+}
        file_error := (ioresult <> 0);
        if file_error then
          exit;

(* To minimize disk access and speed things up, we read the file into a
  scratchpad on the heap. Large files have to be done in two or more
  chunks because of the 64K limit on dynamic memory variables. *)

        getmem(scratch, buffsize);     (* Allocate scratchpad *)
        blockread(pcxfile, scratch^, 128); (* Get header into scratchpad *)

(* The .PCX file has a 128-byte header. Most of it can be ignored if you're
  working with a known format. All we want is the palette information and
  the length of the data line. *)

        move(scratch^, palbuf, 67);
        bytes_per_line := palbuf[66];

(*------------------------ Setup for CGA ---------------------------------*)

        if is_CGA then
          begin
            getmem(buff0, 8000);       (* Allocate memory for output *)
            getmem(buff1, 8000);
            abuff0 := buff0;           (* Make copies of pointers *)
            abuff1 := buff1;
          end
        else

(*----------------------- Setup for EGA/VGA ------------------------------*)
          begin
            video_index := 0;
            port[$3C4] := 2;           (* Index to map mask register *)
            plane := 1;                (* Initialize plane *)
            port[$3C5] := plane;       (* Set sequencer to mask out other planes *)

(*-------------------- Decipher EGA/VGA palette --------------------------*)

(* The palette information is stored in bytes 16-63 of the header. Each of
   the 16 palette slots is allotted 3 bytes - one for each primary color.
   Any of these bytes can have a value of 0-255.

   For the EGA there are just 4 significant settings, since only 64
   different colors (4 x 4 x 4) are available. Hence for EGA-format images
   we divide the codes by 64. The absolute color number for the palette
   entry is derived by setting one of bits 0-2 and one of bits 3-5 with the
   mask corresponding to the .PCX code byte. (In binary form, the absolute
   color number may be thought of as 00RGBrgb.) This number is then passed
   into Turbo's SetAllPalette procedure.

   For the VGA things work differently. Here we must use Turbo's
   SetRGBPalette procedure to change the red, green, and blue values in the
   16 active color registers. The registers expect values in the range 0-63
   (64 x 64 x 64 = 256K, the number of possible colors), so we divide the
   .PCX codes by 4. A further complication is that by default the palette
   entries point to the color registers corresponding to the standard EGA
   colors, so we must change them to point to registers 0-15 instead (or
   else modify registers 0-5, 20, 7, and 56-63). See SHOWVGA.PAS for an
   example of how to set the palette and the registers.

   Note that the palette works differently for the 200-line 16-color modes,
   $0D and $0E. Because these modes use 4-bit palette entries, only the
   default colors are available on the EGA, and their IDs don't correspond
   to those in 350-line mode (e.g. 20 is bright red, not brown). Attempting
   to set the palette with the data from the .PCX header will lead to odd
   results in these modes, and in any case should not be necessary.
*)

            for entry := 0 to 15 do
              begin
                colorID := 0;
                for gun := 0 to 2 do
                  begin
                       (* Get primary color value *)
                    pcxcode := palbuf[16 + entry * 3 + gun];
                    if not is_VGA then
                      begin            (* Interpret for EGA *)
                        case (pcxcode div $40) of
                          0 : mask := $00; (* 000000 *)
                          1 : mask := $20; (* 100000 *)
                          2 : mask := $04; (* 000100 *)
                          3 : mask := $24  (* 100100 *)
                        end;
                        colorID := colorID or (mask shr gun); (* Define two bits *)
                      end              (* not is_VGA *)
                    else
                      begin            (* is_VGA *)
                        with RGBpal[entry] do (* Interpret for VGA *)
                          case gun of
                            0 : redval := pcxcode div 4;
                            1 : greenval := pcxcode div 4;
                            2 : blueval := pcxcode div 4;
                          end
                      end              (* is_VGA *)
                  end;                 (* gun *)
                if is_VGA then
                  pal.colors[entry] := entry
                else
                  pal.colors[entry] := colorID
              end;                     (* entry *)
            pal.size := 16
          end;                         (* not is_CGA *)

(* ---------------- Read and decode the image data ----------------------- *)

        repeatcount := 0;              (* Initialize assembler vars. *)
        columncount := 0;
        repeat
          blockread(pcxfile, scratch^, buffsize, datalength);
          if is_CGA then
            DECODE_CGA
          else
            DECODE_16; (* Call assembler routine *)
        until eof(pcxfile);
        close(pcxfile);
        if not is_CGA then
          port[$3C5] := $F; (* Reset mask map *)
        freemem(scratch, buffsize);    (* Discard scratchpad *)
      end;                             (* READ_PCX_FILE *)

(************************** 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, page_addr              (* 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 *)

(* --------------------- Loop through input buffer ----------------------- *)

        @getbyte :
        cmp si, bx                     (* end of input buffer? *)
        je @exit                       (* yes, quit *)
        lodsb                          (* get byte into AL, increment SI *)
        cmp cl, 0                      (* was prev. byte a count? *)
        jg @multi_data                 (* yes, this is data *)
        cmp al, 192                    (* no, 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 *)
        jmp @getbyte                   (* go get data byte *)
        @one_data :
        stosb                          (* byte into video *)
        jmp @getbyte
        @multi_data :
        rep stosb                      (* write byte CX times *)
        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 *)

(*************************** Initialization *****************************)

BEGIN
  page_addr := page0             (* Destination for EGA/VGA data *)
END.