CD-X 1/cdx_01.iso/demodisc/ca_v_at/cdxintro.pas

Pascal/Delphi Source File | 1995-04-07 | 12.1 KB | 398 lines

{$G+}
uses   crt, dos;

const  MAX_WIDTH = 4000;
       COMPRESS_NUM = $C0;
       MAX_BLOCK = 4096;
       RED = 0;
       GREEN = 1;
       BLUE = 2;

type   file_buffer = array [0..127] of byte;
       block_array = array [0..MAX_BLOCK] of byte;
       pal_array = array [0..255, RED..BLUE] of byte;
       ega_array = array [0..16] of byte;
       line_array = array [0..MAX_WIDTH] of byte;
       pcx_header = record
                       Manufacturer: byte;
                       Version: byte;
                       Encoding: byte;
                       Bits_per_pixel: byte;
                       Xmin: integer;
                       Ymin: integer;
                       Xmax: integer;
                       Ymax: integer;
                       Hdpi: integer;
                       Vdpi: integer;
                       ColorMap: array [0..15, RED..BLUE] of byte;
                       Reserved: byte;
                       Nplanes: byte;
                       Bytes_per_line_per_plane: integer;
                       PaletteInfo: integer;
                       HscreenSize: integer;
                       VscreenSize: integer;
                       Filler: array [74..127] of byte;
                    end;

       type paletterec   = record
                             red,
                             green,
                             blue  : byte;
                           end;
             palettetype = array[0..255] of paletterec;


var    BlockFile   :  file;
       BlockData   :  block_array;
       Header      :  pcx_header;
       Palette256  :  pal_array;
       PCXline     :  line_array;
       Ymax        :  integer;
       NextByte    :  integer;
       Index       :  integer;
       Data        :  byte;
       Reg         :  registers;

       pcx_picture :  pointer;
       pcx_palette :  palettetype;
       temppal     :  palettetype;
       i           :  byte;
       oldint09    :  procedure;

procedure show_palette; { a pcx képek palettáját inicializálja }
var       i: integer;
begin
          for i := 0 to 255 do
             begin
               Palette256 [i, RED]   := Palette256 [i, RED]   shr 2;
               Palette256 [i, GREEN] := Palette256 [i, GREEN] shr 2;
               Palette256 [i, BLUE]  := Palette256 [i, BLUE]  shr 2;
             end;
          Reg.ah := $10;
          Reg.al := $12;
          Reg.bx := 0;
          Reg.cx := 255;
          Reg.dx := ofs (Palette256);
          Reg.es := seg (Palette256);
          intr ($10, Reg);
end;

procedure load_mcga_pic (Y: integer); { soronként elrakja a memóriába a pcx képet }
begin
          Move (PCXline [0], mem[seg(pcx_picture^):y*320], 320);
end;

procedure Read256palette; { betölti a pcx kép palettáját }
var       b: byte;
begin
          seek (BlockFile, FileSize (BlockFile) - 769);
          BlockRead (BlockFile, b, 1);
          BlockRead (BlockFile, Palette256, 3*256);
          seek (BlockFile, 128);
end;

procedure ReadHeader; { a pcx kép fejlécét tölti be }
begin     {$I-}
          BlockRead (BlockFile, Header, 128);
          Ymax := 199;
          Read256palette;
          Index := 0;
          NextByte := MAX_BLOCK;
          {$I+}
end;

procedure ReadByte;  { egy byte-ot tölt be a pcx - képpbôl }
var       NumBlocksRead: integer;
begin
          if NextByte = MAX_BLOCK then
             begin
             BlockRead (BlockFile, BlockData, MAX_BLOCK, NumBlocksRead);
             NextByte := 0;
             end;
          data := BlockData [NextByte];
          inc (NextByte);
end;

procedure read_pcx_line;  { egy sort olvas be a pcx képpbôl }
var       count: integer;
          bytes_per_line: integer;
begin     {$I-}
          bytes_per_line := Header.Bytes_per_line_per_plane * Header.Nplanes;
          if Index <> 0 then FillChar (PCXline [0], Index, data);
          while (Index < bytes_per_line) do
             begin
               ReadByte;
               if (data and $C0) = compress_num then
                  begin
                    count := data and $3F;
                    ReadByte;
                    FillChar (PCXline [Index], count, data);
                    inc (Index, count);
                  end
               else
                  begin
                    PCXline [Index] := data;
                    inc (Index);
                  end;
             end;
           Index := Index - bytes_per_line;
{$I+}
end;

procedure load_pcx (name:  string);  { az egész pcx képet betölti a memóriába }
var       k:  byte;
begin     {$I-}
          assign (blockfile, name);
          reset (blockFile, 1);
          readheader;
          for k := 0 to 199 do
              begin
                read_pcx_line;
                load_mcga_pic (k);
              end;
          close (blockfile);
          {$I+}
end;

Procedure SetPalette (Var PalBuf : PaletteType); Assembler; { a palettát teszi aktuálissá }
Asm
    PUSH DS
    XOR AX, AX
    MOV CX, 0300h / 2
    LDS SI, PalBuf
    MOV DX, 03C8h
    OUT DX, AL
    INC DX
    MOV BX, DX
    CLD
    MOV DX, 03DAh
    @VSYNC0:
      IN   AL, DX
      TEST AL, 8
    JZ @VSYNC0
    MOV DX, BX
    REP
       OUTSB
    MOV BX, DX
    MOV DX, 03DAh
    @VSYNC1:
      IN   AL, DX
      TEST AL, 8
    JZ @VSYNC1
    MOV DX, BX
    MOV CX, 0300h / 2
    REP
       OUTSB
    POP DS
End;

Procedure GetPalette (Var PalBuf : PaletteType); Assembler; { az aktuális palettát kérdezi le }
Asm
    PUSH DS
    XOR AX, AX
    MOV CX, 0300h
    LES DI, PalBuf
    MOV DX, 03C7h
    OUT DX, AL
    INC DX
    INC DX
    CLD
    REP
       INSB
    POP DS
End;

Procedure FadeOutToBlack (Var Palin : PaletteType); { elsötétíti a képernyôt }
Var DAC,
    Intensity : Word;
Begin
     For Intensity := 32 downto 0 do
     Begin
       For DAC := 0 to 255 do
       Begin
          TempPal[DAC].Red   := (Palin[DAC].Red   * Intensity) DIV 32;
          TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;
          TempPal[DAC].Blue  := (Palin[DAC].Blue  * Intensity) DIV 32;
       End;

       SetPalette (TempPal);
     End;
End;

Procedure FadeInFromBlack (Var Palin : PaletteType); { kivilágosítja a képernyôre a megadott palettát }
Var DAC,
    Intensity : Word;
Begin
     For Intensity := 0 to 32 do
     Begin
       For DAC := 0 to 255 do
       Begin
          TempPal[DAC].Red   := (Palin[DAC].Red   * Intensity) DIV 32;
          TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;
          TempPal[DAC].Blue  := (Palin[DAC].Blue  * Intensity) DIV 32;
       End;
       SetPalette (TempPal);
     End;
End;

procedure turnpal; { a palettát forgatja }
var trgb:  paletterec;
begin
     trgb := pcx_palette[1];
     move (pcx_palette[2],pcx_palette[1],254*3);
     pcx_palette[254] := trgb;
end;

procedure turnbackpal; { a palettát visszafelé forgatja }
var trgb:  paletterec;
begin
     trgb := pcx_palette[2];
     move (pcx_palette[1],pcx_palette[2],254*3);
     pcx_palette[254] := trgb;
end;

procedure setvideo(mode:  word); assembler; { videó módot kapcsol }
asm
          MOV AX,mode
          INT $10;
end;

procedure show_pcx; { a képernyôre másolja a memóriából a pcx-képet }
begin
          move(mem[seg(pcx_picture^):0],mem[$A000:0],64000);
end;

procedure drawline(what:byte;towhat:byte); { a memóriából sorokat másol a képernyôre }
begin
          move(mem[seg(pcx_picture^):ofs(pcx_picture^)+320*what],
               mem[$a000:320*towhat],320);
end;

procedure roller; { a képet görgeti }
const     rows       =  199;
          size       =   20;
var       hiddenrow  :  byte;
          visiblerow :  byte;
          i          :  byte;
begin
          hiddenrow  := 0;
          visiblerow := size;
          repeat
            for i := 0 to size do
                if ((visiblerow-i) < rows) and
                   ((hiddenrow+i)  < rows)
                then drawline(hiddenrow+i,visiblerow-i);
            drawline(hiddenrow,hiddenrow);
            inc(hiddenrow);
            inc(visiblerow);
            delay(100);
          until hiddenrow = rows;
end;

procedure show_I; { vízszintessen másolja be az új képet }
var       rows:   array [0..319] of boolean;
          ready:  boolean;
          i:      word;
begin
          for i := 0 to 199 do
              rows[i] := false;
          repeat
                i := random(200);
                if rows[i] = false then
                   begin
                         rows[i] := true;
                             move(mem[seg(pcx_picture^) : i*320],
                                  mem[$A000             : i*320],319);
                         ready := true;
                         for i := 0 to 199 do
                             if rows[i] = false then ready := false;
                   end;
                delay(3);
          until ready = true;
end;

procedure show_II; { függôlegessen másolja be az új képet }
var       rows:   array [0..319] of boolean;
          ready:  boolean;
          y:      word;
          i:      word;
begin
          for i := 0 to 319 do
              rows[i] := false;
          repeat
                i := random(320);
                if rows[i] = false then
                   begin
                         rows[i] := true;
                         for y := 0 to 199 do
                             move(mem[seg(pcx_picture^) : y*320+i],
                                  mem[$A000             : y*320+i],1);
                         ready := true;
                         for i := 0 to 319 do
                             if rows[i] = false then ready := false;
                   end;
                delay(1);
          until ready = true;
end;

{$F+}
procedure newint09; interrupt;
begin
          if port[$60] = 1 then begin       { volt ESC? }
             freemem(pcx_picture,64000);    { felszabadítja a memóriát }
             setvideo($03);                 { visszakapcsol text videó módba }
             writeln('coded by Vodkα  & Kool A');
             writeln('GFX   by Kool A & Vodkα');
             inline($9C);
             oldint09;
             setintvec($09,addr(oldint09));
             halt;
          end;
          inline($9C);                      { ha nem meghívja a régi keyboard interruptot }
          oldint09;
end;
{$F-}

begin
          getintvec($09,@oldint09);      { a régi keyboard interrupt címét elmenti }
          setintvec($09,addr(newint09)); { és ráirányítja az újjat }

          writeln('CD-X intro...');

          getpalette(pcx_palette);    { elmenti az aktuális palettát }
          fadeouttoblack(pcx_palette);{ elsötétít feketébe
                                                                     }
          getmem(pcx_picture,64000);  { helyet foglal a pcx képeknek }
          randomize;
          setvideo($13);              { felkapcsol 320x200x256 MCGA videó módba }

          load_pcx('1.pcx');          { betölti a memóriába az 1. képet }
          show_palette;               { a palettát megmutatja }
          roller;                     { legörgeti a képet }
          delay(100);

          for i := 1 to 5 do begin

              load_pcx('2.pcx');          { betölti a memóriába a 2. képet }
              show_II;                    { függôleges vonalakkal átmossa a 2. képre }
              delay(2000);

              load_pcx('1.pcx');          { betölti a memóriába az 1. képet }
              show_I;                     { vízszintes vonalakkal átmossa az elsô képre }
              delay(2000);

          end;

          getpalette(pcx_palette);    { elmenti az aktuális palettát }
          fadeouttoblack(pcx_palette);{ elsötétíti a képet }
          load_pcx('3.pcx');          { betölti a plasma képet }
          show_palette;
          show_pcx;                   { kirakja a képernyôre az egész képet }
          getpalette(pcx_palette);

          repeat
                turnpal;                 { forgatja a palettát }
                setpalette(pcx_palette); { megjeleníti a palettát }
          until false;
end.