
                           A PCX kpformtum


Ez volt az els olyan kpformtum, amit egy szabad felhasznls raj-
zolprogramhoz ksztett annak idejn a ZSoft cg. Elszr csak ngy
majd 16, ksbb pedig 256 sznben is tudtk kezelni a kpeket. Most
inkbb a mindenkit jobban rdekl 256 sznes verzihoz szeretnk min-
denkit egy kicsit kzelebb invitlni (Bocs nha nagyon magyartalan
vagyok). Szerintem ez az egyik legegyszerbb verzi. A PCX file a k-
vetkezkppen pl fel: a file els 128 byte-ja az n. header, magya-
rosan csak fejlcnek mondjk. A header a kvetkez dolgokrl rulko-
dik: gyrt, verzi, visszakdols, pixelelnknti bit szm, felbonts
16 szn paletta, soronknti byteok szma stb. A fejlc utn kvetke-
zik maga a kp s a file vgn tallhat a 256 szn paletta, ami 768
byte hossz -of course.




A leglnyegesebb taln az, hogy hogyan troljk a kpet. Egy igen pri-
mitv, de nhny esetben azrt a clnak megfelel tmrtst hasznl-
nak. Teht: olvass be egy byteot, vizsgld meg, hogy a kt fels bit
1-e, ha igen akkor az als hat bit egy index szm, ami arrl rulkodik
hogy a kvetkez beolvasand byteot hnyszor kell kirni.Ha a kt fel-
s bit nem 1 akkor simn rjuk ki a byteot a kpernyre. Ezt rakd be 1
ciklusba,ami a 1tl a maximlis kperny sorokig fog futni s mr ksz
is a kped. Ja, igen nem rtana a palettt sem definilni: mindegyik
byte mindegyik bitjt kettvel kell jobbra cssztatni - egyszerbben:
SHR ..,2 (esetleg SHR ..,1 SHR ..,1   vagy csen: >> 2 ) s ezutn mr
be is llthatod a szneket. Na, de hogy ne csak a szmat jrtassam,
kzreadok egy pldaprogramot azoknak, akik ezek utn nem tudnk megr-
ni a sajt dekdol rutinjukat. Ja, de ha valaki mg is sajt rutint
szeretne rni, az a next oldalon megnzheti, hogy hogyan is nz ki a
haader.


                                                                   OSI

Typedef 
 Struc {
  char manufacturer;         // mindig A0H
  char version;              // 256 sznnl: 5
  char encoding;             
  char bits_per_pixel;       
  int  xmin, ymin;
  int  xmax, ymax;
  int  hres;
  int  vres;
  char palette[48];
  char reserved;
  char colour_planes;
  int  bytes_per_line;
  int  palette_type;
  char filler[58];           // ezt arra hasznlhatod amire akarod
 } PCXHEAD;

Sorry azoknak, akiknek mg nincs meg a BANK s az SVGAVAR unit, azt
majd egy msik cikkben megtallja (ha mg eddig nem sikerlt). Ha
mgsem tallja akkor:  vagy kimaradt az jsg mostani szmbl,
                       vagy a kvetkez szmban lesz csak benn.

{$G+}

UNIT PCX;

INTERFACE

Procedure ReadPCX ( Source : String; StartPos : Longint );

IMPLEMENTATION

Uses Crt, Bank, SvgaVar;



Type
     PcxHead = Record
       Manufacturer : Byte;
       Version      : Byte;
       Encoding     : Byte;
       BitsPerPixel : Byte;
       Xmin, Ymin   : Integer;
       Xmax, Ymax   : Integer;
       Hres, Vres   : Integer;
       Palette      : Array[1..48] Of Byte;
       Reserved     : Byte;
       ColourPlanes : Byte;
       BytesPerLine : Integer;
       PaletteType  : Integer;
       File_Size    : Longint;
       Filler       : Array[1..54] Of Byte;
     End;
     GfxColours  = Array[1..768] of Byte;
     Buffer      = Array[1..$FFFF] Of Byte;
Const
     N              : Word=0;

Var
     C              : GfxColours;
     Header         : PcxHead;
     Width, Depth   : Integer;
     Bytes          : Integer;
     Palette        : Array[1..768] Of Byte;
     F              : File;
     NN             : Integer;
     Sorok          : Integer;
     P              : Pointer;






{$F+}
Procedure SetAllColours ( C : GfxColours ); Assembler;
Asm
  PUSH DS
  POP  ES
  MOV  AX,1012H
  MOV  BX,0
  MOV  CX,100H
  MOV  DX,[BP+6]
  INT  10H
End;
{$F-}







Function Exist ( S : String ) : Boolean;
Var              F:File;
Begin
  Assign(F,S);
  {$I-}
  Reset(F,1);
  {$I+}
  If IoResult=0 Then Begin
    Close(F);
    Exist:=True;
  End Else Exist:=False;
End;







Procedure ReadPcxLines;
Var       I              : Integer;
          C              : Byte;
          Hanyadik       : Byte;
          Sor            : Integer;
Begin
  Sorok:=0;
  Hanyadik:=0;
  While Sorok<Depth+1 Do Begin
      Blockread(F,C,1);
      C:=C AND $FF;
      If (C AND $C0=$C0) Then Begin
        I:=C AND $3F;
        Blockread(F,C,1);
        While (I>0) And (Sorok<=Depth+1) Do Begin
          Mem[$0A000:N]:=C;
          Dec(I);
          If N=$FFFF Then Begin
            N:=0;
            Inc(Hanyadik);
            NewBank(Hanyadik);
          End Else
          Inc(N);
          Inc(Sor);
          If Sor>Bytes Then Begin
            Inc(Sorok);
            Sor:=1;
            If (Bytes<>320) Or (Bytes<>640) Then Begin
              If Bytes<=320 Then Inc(N,320-Bytes)
              Else Inc(N,640-Bytes);
            End;
          End;
        End;
      End Else Begin
        Mem[$0A000:N]:=C;
        If N=$FFFF Then Begin
          N:=0;
          Inc(Hanyadik);
          NewBank(Hanyadik);
        End Else Inc(N);
        Inc(Sor);
        If Sor>Bytes Then Begin
          Inc(Sorok);
          Sor:=1;
          If (Bytes<>320) Or (Bytes<>640) Then Begin
            If Bytes<=320 Then Inc(N,320-Bytes)
            Else Inc(N,640-Bytes);
          End;
        End;
      End;
  End;
End;








Function EightBitToSixBit ( B:Byte ) : Byte; Assembler;
ASM
  XOR AX,AX
  MOV AL,B
  SHR AX,2
END;

Procedure ConvertColoursTo6Bit ( Var C:GfxColours );
Var       I:Integer;
Begin
  For I:=1 To 768 Do C[I]:=EightBitToSixBit(C[I]);
End;




Procedure UnpackPcxFile;
Var       I         : Integer;
          Sor       : String[2];
          Ch        : Char;
Begin

  Mode($13);

  If GetMode<>$13 Then Begin
    Writeln('Sorry EGA/VGA need!');
    Close(F);
    Halt;
  End;

  If Width<=320 Then Mode($13);

  If (Width<=640) And (Width>=321) Then Begin
      Sor:=#13+#10;
      Mode(3);
      Writeln(Sor,'  Vlaszd ki a megfelel video chipset: ',Sor,
                '    1.     VESA',Sor,
                '    2.     TRIDENT',Sor,
                '    3.     OAK (067,077)',Sor,
                '    4.     TSENG 4000',Sor,
                '    5.     COMPAQ [ezt ne vlaszd!]',Sor,
                '    6.     REALTEK',Sor,
                '    7.     CIRRUS',Sor,
                '    8.     PARADISE',Sor,
                '    9.     EVEREX',Sor,
                '    0.     S3 Accelator',Sor,
                '    a.     ACUMOS',Sor,
                '    b.     TRIDENT 8900',Sor,
                '    c.     ATIVGA',Sor,
                '    d.     AHEAD A',Sor,
                '    e.     AHEAD B',Sor,
                '    f.     VIDEO 7',Sor,
                '    g.     CHIPS & TECH',Sor,
                '    h.     GENOA',Sor,
                '    i.     NCR',Sor,
                '    j.     TSENG 3000');
      Repeat
        Ch:=Readkey;
        Ch:=Upcase(Ch);
      Until Ch IN ['0'..'9','A'..'J',#13];
      Case Ch Of
        #13 : VESA:=True;
        #27 : VESA:=True;
        '1' : VESA:=True;
        '2' : TRIDENT:=True;
        '3' : OAKTECH:=True;
        '4' : TSENG4:=True;
        '5' : COMPAQ:=True;
        '6' : REALTEK:=True;
        '7' : CIRRUS:=True;
        '8' : PARADISE:=True;
        '9' : EVEREX:=True;
        '0' : S3:=True;
        'A' : ACUMOS:=TRUE;
        'B' : T8900:=TRUE;
        'C' : ATIVGA:=True;
        'D' : AHEADA:=TRUE;
        'E' : AHEADB:=TRUE;
        'F' : VIDEO7:=TRUE;
        'G' : CHIPSTECH:=TRUE;
        'H' : GENOA:=TRUE;
        'I' : NCR:=TRUE;
        'J' : TSENG:=True;
      End;
    ModeSVGA;
    NewBank(0);
  End;
  ConvertColoursTo6Bit(C); SetAllColours(C);
  ReadPcxLines; 
  Readkey; 
  Mode(3);
End;
Procedure ReadPCX;
Begin
  If Not Exist(Source) Then Exit;
  Assign(F,Source);
  Reset(F,1);
  Seek(F,StartPos);
  If FileSize(F)<896 Then Begin
    Close(F);
    Writeln('This file is too short!');
    Exit;
  End;
  N:=0;
  Blockread(F,Header,SizeOf(Header));
  If Header.Manufacturer=$0A Then Begin
    If Header.Version=5 Then Begin
      Seek(F,StartPos+Header.File_Size-768);
      Blockread(F,C,768);
      Seek(F,StartPos+128);
      Width:=(Header.Xmax-Header.Xmin)+1;
      Depth:=(Header.Ymax-Header.Ymin)+1;
      Bytes:=Header.BytesPerLine;
      UnpackPcxFile;
    End
    Else Writeln('This PCX file not 256 colours!');
  End
  Else Writeln('Not a valid PCX file!');
  Close(F);
End;

BEGIN
  { Please don't modify this text! }
  Writeln('Coded by OSI, 1993-08-20');
  Delay(1000);
END.



