[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

     > Does anyone have a program (not necessarily source) that will
     > take a full
     > screen GIF or PCX or whatever graphic format and convert it into
     > something I can load in Pascal?  Or even a graphic editor that

    You can load a .PCX in pascal! No conversion needed. Here is some source.

    { MCGA PCX decode by Bas van Gaalen, Holland, PD }
    { Modified to use virtual screen/pointers by Ricky Booth, USA, PD }

    {$M 65520, 4096, 655360}
    {$I-}

    program pcx_view;

    uses
      crt;

    type
      pcxheader = record
        manufacturer,version,encoding,bits_per_pixel : byte;
        xmin,ymin,xmax,ymax,hres,vres : word;
        palette : array[0..47] of byte;
        reserved : byte;
        color_planes : byte;
        bytes_per_line : word;
        palette_type : word;
        filler : array[0..57] of byte;
      end;

    var
      pcxfile : file;
      header : pcxheader;

    {----------------------------------------------------------------------------}

    procedure error(errstr : string);
    begin
      writeln(errstr);
      halt;
    end;

    {----------------------------------------------------------------------------}

    function validpcx : boolean;
    begin
      seek(pcxfile,0);
      blockread(pcxfile,header,sizeof(header));
      with header do validpcx := (manufacturer = 10) and (version = 5) and
        (bits_per_pixel = 8) and (color_planes = 1);
    end;

    {----------------------------------------------------------------------------}

    function validpal : boolean;
    var v : byte;
    begin
      seek(pcxfile,filesize(pcxfile)-769);
      blockread(pcxfile,v,1);
      validpal := v = $0c;
    end;

    {----------------------------------------------------------------------------}

    procedure setvideo(md : word); assembler;
    asm
      mov ax,md
      int 10h
    end;

    {----------------------------------------------------------------------------}

    CONST VGA = $a000;  (* This sets the constant VGA to the segment of the
                           VGA screen.                                      *)

    Type Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
         VirtPtr = ^Virtual;                  { Pointer to the virtual screen }

    VAR Virscr : VirtPtr;                     { Our first Virtual screen }
        Vaddr  : word;                        { The segment of our virtual screen}

    procedure setpal;
    var pal : array[0..767] of byte;
    begin
      seek(pcxfile,filesize(pcxfile)-768);
      blockread(pcxfile,pal,768);
      asm
        cld
        xor di,di
        xor bx,bx
       @L1:
        mov dx,03c8h
        mov ax,bx
        out dx,al
        inc dx
        mov cx,3
       @L2:
        mov al,byte ptr pal[di]
        shr al,1
        shr al,1
        out dx,al
        inc di
        loop @L2
        inc bx
        cmp bx,256
        jne @L1
      end;
    end;

    {----------------------------------------------------------------------------}

    Procedure SetUpVirtual;
    BEGIN
      GetMem (VirScr,64000);
      vaddr := seg (virscr^);
    END;

    procedure unpack;
    var gofs,j : word; i,k,v,loop : byte;
    begin
      seek(pcxfile,128);
      gofs := 0;
      for i := 0 to header.ymax-header.ymin+1 do begin
        j := 0;
        while j < header.bytes_per_line do begin
          blockread(pcxfile,v,1);
          if (v and 192) = 192 then begin
            loop := v and 63;
            inc(j,loop);
            blockread(pcxfile,v,1);
            for k := 1 to loop do begin
              Mem[Vaddr:gofs] := v;
              inc(gofs);
            end;
          end
          else begin
            Mem[Vaddr:gofs] := v;
            inc(gofs);
            inc(j);
          end;
        end;
      end;
    end;

    Procedure WaitRetrace; assembler;
    label
      l1, l2;
    asm
        mov dx,3DAh
    l1:
        in al,dx
        and al,08h
        jnz l1
    l2:
        in al,dx
        and al,08h
        jz  l2
    end;

    {----------------------------------------------------------------------------}

    begin
      SetUpVirtual; (*initilizes the pointers*)
      if paramstr(1) = '' then error('Enter filename on commandline.');
      assign(pcxfile,paramstr(1));
      reset(pcxfile,1);
      if ioresult <> 0 then error(paramstr(1)+' not found.');
      if not validpcx then error('Not a 256 color PCX file.');
      if not validpal then error('Palette corrupt.');
      Writeln('Decoding Image...');
      Unpack;
      Setvideo($13);
      Setpal;
      Move(Virscr^,MEM[VGA:0],64000); (*Stick the virtual page to the vga mem*)
      repeat until keypressed;
      While keypressed do readln;
      setvideo(3);
      close(pcxfile);
      FreeMem (VirScr,64000); (*Free up virtual memory*)
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]