Графический движок Опции

[AlaRic]

Сможем написать или нет?

[AlaRic]

Пакет предназначен для вывода графических изображений из файлов формата PCX.

{*********************************************************************
****}
{                                                                         }
{      PCXLIB.PAS - Display graphic pictures from PCX format files.       }
{                   Support CGA/EGA/VGA videoadapters.                    }
{                                                                         }
{                             Version 1.00                                }
{                                                                         }
{      Copyright © 1992 by Zhachkin K.V. / UnfoService-Unison /         }
{                                                                         }
{*************************************************************************}


{ Note :    This module not check current videoadapter and disk errors.  }


{$S-,F+}    { !!!   Don't change this directives   !!! }

{$I-}

Unit PCXLib;

{ ************************* } InterFace { ************************ }

Uses  Dos,
      TPString;

Const DiskBufSize = 20000; { Range 1..65530 }

Type  ValidMode = ( CGA320x200x4,  CGA640x200x2, EGA320x200x16, EGA640x200x16,
                    EGA640x350x2, EGA640x350x16, VGA640x480x2, VGA640x480x16,
                    VGA320x200x256,  DUMMYMODE);  { DUMMYMODE - End of type }

      ModeRec = Record
       XRes,
       YRes         : Word;
       BitsPerPixel,
       NPlanes,
       VideoMode    : Byte;
      end;

Const MyModes:Array[ValidMode] OF ModeRec =

       ((XRes:320;YRes:200;BitsPerPixel:2; NPlanes:1; VideoMode:$04),
        (XRes:640;YRes:200;BitsPerPixel:1; NPlanes:1; VideoMode:$06),
        (XRes:320;YRes:200;BitsPerPixel:1; NPlanes:4; VideoMode:$0D),
        (XRes:640;YRes:200;BitsPerPixel:1; NPlanes:4; VideoMode:$0E),
        (XRes:640;YRes:350;BitsPerPixel:1; NPlanes:1; VideoMode:$0F),
        (XRes:640;YRes:350;BitsPerPixel:1; NPlanes:4; VideoMode:$10),
        (XRes:640;YRes:480;BitsPerPixel:1; NPlanes:1; VideoMode:$11),
        (XRes:640;YRes:480;BitsPerPixel:1; NPlanes:4; VideoMode:$12),
        (XRes:320;YRes:200;BitsPerPixel:8; NPlanes:1; VideoMode:$13),
        (XRes:000;YRes:000;BitsPerPixel:0; NPlanes:0; VideoMode:$00));

Var   VideoPage : Byte;

Procedure DrawPCX( FName:String; VAR Page:Byte );

{ *********************** } Implementation { ************************}

Type  PCXHeader = Record
       PCXid            : Byte;
       VersionNo        : Byte;
       Encoding         : Byte;
       BitsPerPixel     : Byte;
       XL,YL,XH,YH      : Word;
       Xres,YRes        : Word;
       Palette          : Array[1..48] OF Byte;
       Reserved         : Byte;
       NPlanes          : Byte;
       BytesPerLine     : Word;
       PaletteInfo      : Word;
       Reserved2        : Array[1..58] OF Byte;
      end;
                                
      MyArray = Array[1..65000] OF Byte;


Procedure CGA_CO_Palette(Hdr:PCXHeader); { Set CGA palette for 320x200 mode }

Var  Fore,BackGround : Byte;

 begin
  Fore:=Hdr.Palette[4] SHR 5;
  BackGround:=Hdr.Palette[1] SHR 4;
  IF Fore > 4 THEN Dec(Fore,4);
  IF Not (Fore IN [0,2]) THEN BackGround:=BackGround OR $10;
  IF Fore > 1 THEN Fore:=1
              ELSE Fore:=0;
  asm
   mov   bh,0
   mov   bl,byte ptr BackGround
   mov   ah,0Bh
   int   10h
   mov   bh,1
   mov   bl,byte ptr Fore
   mov   ah,0Bh
   int   10h
  end;
 end;

Procedure CGA_BW_Palette(Hdr:PCXHeader); { Set CGA palette for 640x200 mode }

Var BackGround : Byte;

 begin
  BackGround:=Hdr.Palette[1] SHR 4;
  asm
   mov   bh,1
   mov   bl,byte ptr BackGround
   mov   ah,0Bh
   int   10h
  end;
 end;


Procedure EGA_16_Palette(Hdr:PCXHeader); { Set palette for EGA color modes }

Var    I      : Byte;
       Pal    : Array[0..16] OF Byte;
       PalPtr : Pointer;

 begin
  PalPtr:=@Pal;
  With Hdr DO
   begin
    FOR i:=0 TO 15 DO
     begin
      Pal[i]:=((Palette[i*3+1] AND $48 )+
               (Palette[i*3+2] AND $48 ) SHR 1+
               (Palette[i*3+3] AND $48 ) SHR 2) SHR 1;
     end;
   end;
  Pal[16]:=0;
  asm
   les   dx,PalPtr
   mov   ax,1002h
   int   10h
  end;
 end;

Procedure VGA_256_Palette(Hdr:PCXHeader; Var F:File);

{ Set palette for 256-colors VGA mode }

Var    I      : Word;
       Pal    : Array[0..768] OF Byte;
       PalPtr : Pointer;

 begin
  PalPtr:=@Pal[1];
  Seek(F,FileSize(F)-769);
  BlockRead(F,Pal,769);
  IF Pal[0] = $0C THEN FOR i:=1 TO 768 DO Pal[i]:=Pal[i] SHR 2;
  Seek(F,SizeOF(PCXHeader));
  asm
   les   dx,PalPtr
   mov   ax,1012h
   mov   cx,100h
   mov   bx,0
   int   10h
  end;
 end;

Procedure VGA_16_Palette(Hdr:PCXHeader); { Set palette for 16-colors VGA mode }

Var    Pal     : Array[1..48] OF Byte;
       CurrPtr : Pointer;
       i       : Byte;

 begin
  FOR i:=1 TO 48 DO Pal[i]:=Hdr.Palette[i] SHR 2;
  CurrPtr:=@Pal[1];
  FOR i:=0 TO 15 DO
   begin
    asm
     les    di,CurrPtr
     mov    ax,1007h
     mov    bl,byte ptr i
     int    10h
     mov    bl,bh
     xor    bh,bh
     mov    ax,1010h
     mov    dh,byte ptr es:[di]
     mov    ch,byte ptr es:[di+1]
     mov    cl,byte ptr es:[di+2]
     int    10h
    end;
   Inc(LongInt(CurrPtr),3);
   end;

 end;

{ *************************** DrawPCX **************************** }

Procedure DrawPCX( FName:String; VAR Page:Byte );

Type  OffsSeg = Record
       Offs,Seg:Word
      end;

Var   DiskBuf,
      ScrBuf             : ^MyArray;
      DiskBufRec       : OffsSeg Absolute DiskBuf;
      ScrBufRec             : OffsSeg Absolute ScrBuf;
      FHandle,
      i,XLen,YLen,
      ScrOfs,
      BytesPerRow,      { Screen row length (in bytes) }
      ByteNum,          { Byte number to output in line }
      VideoBase,
      NLines             : Word;
      InitOutputProc     : Pointer;
      TestMode           : ModeRec;  { Video parameters from file header}
      Hdr                : PCXHeader;
      F                  : File;
      Mode               : ValidMode;

Label OurMode;

Procedure NextBlock(FHandle:Word); Assembler;
 asm
  push  bx                  { Dsik error not check !!! }
  push  cx

  xor   dx,dx
  mov   cx,DiskBufSize
  mov   bx,word ptr FHandle
  mov   ah,3Fh
  int   21h
                    { jc error_label   for dirk error handling }
  pop   cx
  pop   bx
 end;

{$F-}
Procedure Init_Output_1_Planes; Assembler;
 asm
   mov   bp,word ptr [bp+4]        { Initial settings before output string }
                                   { to video buffer for 1-bit plane mode  }
   inc   word ptr NLines           {          ( BW EGA,VGA 256 )           }

   mov   ax,word ptr NLines
   cmp   word ptr YLen,ax
   je    @Finish

   mov   ax,word ptr BytesPerRow
   add   word ptr ScrOfs,ax

   xor   ax,ax
   jmp   @Exit

@Finish:

   xor   ax,ax
   inc   ax

@Exit:

 end;

Procedure Init_Output_4_Planes; Assembler;
 asm
   mov   bp,word ptr [bp+4]     { Initial settings before output string }
                                { to video buffer for 4-bit plane mode  }
   cmp   bl,10h                 {          ( Color EGA,VGA  )           }
   jne   @Not_10

   mov   bl,1
   inc   word ptr NLines
   mov   ax,word ptr BytesPerRow
   add   word ptr ScrOfs,ax

   mov   ax,word ptr NLines
   cmp   word ptr YLen,ax
   je    @Finish

@Not_10:

   mov   dx,3C4h
   mov   al,2
   out   dx,al     { Select Bit Plane }
   inc   dx
   mov   al,bl
   out   dx,al

   shl   bl,1

   xor   ax,ax
   jmp   @Exit

@Finish:

   xor   ax,ax
   inc   ax

@Exit:

 end;

Procedure Init_Output_CGA; Assembler;
 asm
   mov   bp,word ptr [bp+4]         { Initial settings before output string }
                                    {      to video buffer for CGA mode     }
   inc   word ptr NLines

   cmp   byte ptr VideoBase+1,0B8h
   je    @Even_Line

   mov   byte ptr VideoBase+1,0B8h
   mov   ax,word ptr NLines
   cmp   word ptr YLen,ax
   je    @Finish

   mov   ax,word ptr BytesPerRow
   add   word ptr ScrOfs,ax
   jmp   @Not_Finish

@Even_Line:

   mov   byte ptr VideoBase+1,0BAh

@Not_Finish:

   xor   ax,ax
   jmp   @Exit

@Finish:

   xor   ax,ax
   inc   ax

@Exit:

 end;

{$F+}

 begin
  IF Pos('.',FName) = 0 THEN FName:= ParamStr(1) +'.PCX';
  Assign(F,FName);
  Reset(F,1);
  IF IOResult <> 0 THEN
    begin
      Writeln('File ',FName,' not found.');
      Halt(1);
    end;

  BlockRead(F,Hdr,128);
                           { IF IOResult <> 0 THEN .... }
  With Hdr DO
   begin
    IF PCXid <> $0A THEN
     begin
      Writeln('File ',FName,' not PCX file.');
      Halt(1);
     end;

    TestMode.XRes:=XRes;
    TestMode.YRes:=YRes;
    TestMode.BitsPerPixel:=BitsPerPixel;
    TestMode.NPlanes:=NPlanes;
   end;

          { Check for validity video parameters }

  FOR Mode:=ValidMode(0) TO DUMMYMODE DO
    IF CompStruct(TestMode, MyModes[Mode], 6) = Equal THEN GoTo OurMode;

  Writeln('File ',FName,' is not my image.');
  Writeln(' XRes=',TestMode.XRes,
          ' YRes=',TestMode.YRes,
          ' BitsPerPixel=',TestMode.BitsPerPixel,
          ' NPlanes=',TestMode.NPlanes);
  Halt(1);

OurMode:

  i:=MyModes[Mode].VideoMode;
  asm
   mov      ax,word ptr i          { Set required mode }
   int      10h
  end;

  FHandle:=FileRec(F).Handle;

  With Hdr DO
   begin
    XLen:=BytesPerLine;
    YLen:=Succ(YH-YL);
    ByteNum:=Succ(XH-XL) DIV 8 * MyModes[Mode].BitsPerPixel;
    BytesPerRow:=XRes DIV 8 * MyModes[Mode].BitsPerPixel;
    GetMem(ScrBuf,XLen+63+16);
    GetMem(DiskBuf,DiskBufSize+16);
   end;

   { Normalize pointers - for higher speed }

  DiskBufRec.Seg:=DiskBufRec.Seg+DiskBufRec.Offs SHR 4+1;
  DiskBufRec.Offs:=0;
  ScrBufRec.Seg:=ScrBufRec.Seg+ScrBufRec.Offs SHR 4+1;
  ScrBufRec.Offs:=0;


 ScrOfs:=0;
 IF Mode IN [EGA320x200x16, EGA640x200x16, EGA640x350x2, EGA640x350x16] 
         THEN ScrOfs:=VideoPage*MemW[0:$44C]
         ELSE VideoPage:=0;                   { Only 1 VideoPage Allowed }


   { Set Palette }

  CASE Mode OF

CGA320x200x4  : CGA_CO_Palette(Hdr);
CGA640x200x2  : CGA_BW_Palette(Hdr);
VGA320x200x256: VGA_256_Palette(Hdr,F);
VGA640x480x16 : VGA_16_Palette(Hdr);
           ELSE IF Hdr.NPlanes = 4 THEN EGA_16_Palette(Hdr);

  end; { CASE }

 IF Hdr.NPlanes = 4 THEN
                     begin
                      NLines:=0;
                      VideoBase:=$A000;
                      InitOutputProc:=Addr(Init_Output_4_Planes)
                     end
                    ELSE
                     begin
                      ScrOfs:=Word(ScrOfs-BytesPerRow);
                      NLines:=Word(-1);
                      VideoBase:=$A000;
                      InitOutputProc:=Addr(Init_Output_1_Planes);
                     end;

 IF Mode IN [CGA320x200x4, CGA640x200x2] THEN
   begin
    NLines:=Word(-1);
    VideoBase:=$BA00;
    InitOutputProc:=Addr(Init_Output_CGA);
   end;

  asm
   push  ds                            { CX - repeating counter       }
   mov   si,word ptr DiskBuf+2         { DS:SI - DiskBuf              }
   mov   ds,si                         { ES:DI - ScrBuf               }
   xor   si,si                         { BL - Bit Map Mask (1,2,4,8,) }
   mov   di,word ptr ScrBuf+2
   mov   es,di
   xor   di,di
   push  word ptr FHandle
   push  bp
   call  NextBlock
   xor   si,si


@Not_1_Plane:

   mov   bl,1                   { Mask  for 4-Planes }
   mov   cx,0

@Repeat:

   lodsb

   or    cx,cx
   je    @Not_Fill

   rep   stosb
   jmp   @Za_IF

@Not_Fill:

   cmp   al,0C0h
   jnb   @Not_Ordinal

   stosb
   jmp   @Za_IF

@Not_Ordinal:

   and   al,3Fh
   xor   ah,ah
   mov   cx,ax

@Za_IF:

   mov   ax,si
   inc   ax
   cmp   ax,DiskBufSize
   jna   @Not_NextBlock

   push  word ptr FHandle
   push  bp
   call  NextBlock
   xor   si,si

@Not_NextBlock:

   mov   ax,di
   inc   ax
   cmp   ax,word ptr XLen
   jna   @Not_Show

{ ***************************** SHOW LINE *************************** }

   push  bp
   call  word ptr InitOutputProc
   or    ax,ax
   jne   @End_Picture

   push  cx

   sub   di,word ptr XLen
   mov   cx,di

   push  ds
   push  si
   push  di

   push  es
   pop   ds

   push       cx      
   push  es

   mov   ax,word ptr VideoBase
   mov   es,ax
   mov   di,word ptr ScrOfs
   xor   si,si
   mov   cx,word ptr ByteNum
   rep   movsb

   pop   es
   pop       cx

   xor   di,di
   mov   si,di
   add   si,word ptr XLen
   rep   movsb

   pop   di
   pop   si
   pop   ds

   pop   cx

{ ******************************************************************* }

@Not_Show:
   jmp   @Repeat

@End_Picture:
   pop   ds
  
  end;
 end;

end.           { ********* End of PCXLib ********* }