old/PAS/!SPbSTU/Graph/expl-gen.pas

Uses Graph;
const
 table :array [0..15] of byte  = (0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);
Procedure EGAVGADriver;external;
var
 inp,outp : file;
 p        : pointer;
 Name     : string[30];
 Size     : word;
 k,i,j    : word;
 x,y      : word;
 val      : byte;
 gD,gM    : Integer;
begin
 gD:=Detect;
 {$L EGAVGA.OBJ}
 RegisterBGIDriver(@EGAVGADriver);
 InitGraph(gD,gM,'');
 Assign(outp,'expls.dat');
 ReWrite(outp,1);
 k:=7;
 BlockWrite(OUTP,k,2);
 Name:='Expls\expl1.tga';
 for k := 1 to 7 do
 begin
  Name[11] := chr(k+$30);
  OutTextXY(300,200,Name);
  Assign(inp,Name);
  Reset(inp,1);
  Seek(INP,12);
  BlockRead(inp,x,2);
  BlockRead(inp,y,2);
  Seek(Inp,$42);
  for i := 1 to y do
    for j := 1 to x do
     begin
      BlockRead(INP,val,1);

       if val <> $F  then
         PutPixel(j,i,table[val and $F])
       else
         PutPixel(j,i,0);

      if val <> $F  then
        PutPixel(j,i+y, 0)
      else
        PutPixel(j,i+y,White);
     end;
  Close(INP);
  Size := ImageSize(1,1,x,y);
  BlockWrite(OUTP,Size,2);
  GetMem(P,Size);
  GetImage(1,1,x,y,P^);
  BlockWrite(OUTP,P^,Size);
  GetImage(1,1+y,x,2*y,P^);
  BlockWrite(OUTP,P^,Size);
  FreeMem(P,Size);
  ReadLn;
  ClearDevice;
 end;
 CloseGraph;
 Close(OUTP);
end.