home *** CD-ROM | disk | FTP | other *** search
/ The Equalizer BBS / equalizer-bbs-collection_2004.zip / equalizer-bbs-collection / DEMOSCENE-STUFF / FV-FV#01.ZIP / FATALVIS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-14  |  8KB  |  264 lines
  1. {$G+,A+,R-,S-,I-,N-,E-,X+,V-}
  2. {$M 8192,0,65536}
  3. {$L MUSIC}
  4.  
  5. Program FatalVision_Intro;
  6.  
  7. { FatalVision intro                         }
  8. { Programmed by BoRZoM on 13/06/94          }
  9. { Using VECTOR/MODE-X/SOUND units by BoRZoM }
  10. { Graphics is Generated using BoRZoM's code }
  11. { ----------------------------------------- }
  12. { Greetingz goes to MathMaster              }
  13.  
  14. Uses DOS, CRT, MODEX, VECTOR, STOOL, PICTURE;
  15.  
  16. Type
  17.   FontType = Array [0..255, 0..7] of Byte;
  18.  
  19. Const
  20.   VecPts   = 8;                          { Simple 8-point cube }
  21.   NoVGA    : String = 'Sorry, VGA adapter required.';
  22.   Credits  : String = 'Intro designed/coded by [BoRZoM/Trouble Makers]';
  23.   SoundCard: String = 'Adlib or compatible card detected!';
  24.   Scroller : String =
  25.              'Hi! Well, here is another idiotic intro, '+
  26.              'for FatalVision coded by BoRZoM/FatalVision. Just '+
  27.              'wanted to say "Hi!", and dont forget us! Greetz '+
  28.              'to: Trouble Makers team, Matt Prichard... '+
  29.              'SEPULTURA RULES! '+
  30.              'Later on dudez...                                 ';
  31.   Vectors  : Array [1..4] of Array [1..8] of Point3D = (
  32.    ((x:-50;y:-50;z:-50),  { Cube }
  33.     (x: 50;y:-50;z:-50),
  34.     (x: 50;y:-50;z: 50),
  35.     (x:-50;y:-50;z: 50),
  36.     (x:-50;y: 50;z:-50),
  37.     (x: 50;y: 50;z:-50),
  38.     (x: 50;y: 50;z: 50),
  39.     (x:-50;y: 50;z: 50)),
  40.  
  41.    ((x: 50;y:-50;z:-50), { Something weird }
  42.     (x: 50;y:-50;z: 50),
  43.     (x:-50;y:-50;z: 50),
  44.     (x:-50;y:-50;z:-50),
  45.     (x:-50;y: 50;z:-50),
  46.     (x: 50;y: 50;z:-50),
  47.     (x: 50;y: 50;z: 50),
  48.     (x:-50;y: 50;z: 50)),
  49.  
  50.    ((x:-50;y:-50;z:-50), { Pyramid }
  51.     (x: 50;y:-50;z:-50),
  52.     (x: 50;y:-50;z: 50),
  53.     (x:-50;y:-50;z: 50),
  54.     (x: 00;y: 50;z: 00),
  55.     (x: 00;y: 50;z: 00),
  56.     (x: 00;y: 50;z: 00),
  57.     (x: 00;y: 50;z: 00)),
  58.  
  59.    ((x:-30;y:-70;z: 00), { Line }
  60.     (x:-30;y:-70;z: 00),
  61.     (x: 30;y: 70;z: 00),
  62.     (x: 30;y: 70;z: 00),
  63.     (x: 00;y: 00;z: 00),
  64.     (x: 00;y: 00;z: 00),
  65.     (x: 00;y: 00;z: 00),
  66.     (x: 00;y: 00;z: 00)));
  67.  
  68.   VectorLines : Array [1..12, 1..2] of Byte = (
  69.     (1, 2), (2, 3), (3, 4), (4, 1),
  70.     (5, 6), (6, 7), (7, 8), (8, 5),
  71.     (1, 5), (2, 6), (3, 7),
  72.     (4, 8));
  73.  
  74. Var
  75.   X,  Y,  Z,
  76.   RX, RY, RZ,
  77.   XX, YY, ZZ,
  78.   VX, VY, VXI,
  79.   VYI        : Integer;
  80.   NewVector,
  81.   TempVector : Array [1..VecPts] of Point3D;
  82.   Palette1,
  83.   Palette2   : Array [0..767] of Byte;
  84.   TextBitmap : Array [0..7, 0..79] of Byte;
  85.   SinTable   : Array [0..255] of ShortInt;
  86.   CharTable  : ^FontType;
  87.   CurPOS     : 0..7;
  88.   CurPAGE    : 0..3;
  89.   CurSIN,
  90.   OldSIN,
  91.   CurSIZ,
  92.   CurCHR     : Word;
  93.   VGA        : Boolean;
  94.   Old9       : Pointer;
  95.   Wrd        : Word;
  96.   Adlib      : Boolean;
  97.  
  98. procedure Music; external;
  99.  
  100. procedure Getfont; assembler;            { Returns address of 8x8 font }
  101. asm                                      { into CharTable pointer      }
  102.   mov  ax, 1130h
  103.   mov  bh, 1
  104.   int  10h
  105.   mov  word(CharTable+2),es
  106.   mov  word(CharTable),bp
  107. end;
  108.  
  109. procedure Nothing; interrupt;            { new keyboard interrupt      }
  110. begin
  111.   asm
  112.     push 40h
  113.     pop  es
  114.     xor  al, al
  115.     mov  es:[17h], al
  116.     pushf
  117.     call old9
  118.   end;
  119. end;
  120.  
  121. Begin
  122.   asm
  123.     mov  Vga, 1
  124.     mov  ax, 1a00h
  125.     int  10h
  126.     cmp  al, 1ah
  127.     je   @ok
  128.     mov  Vga, 0
  129.     @ok:
  130.   end;
  131.   if not Vga then begin                  { adapter is VGA?          }
  132.     writeln (NoVGA);                     { no, print error message  }
  133.     halt;                                { and exit to dos          }
  134.   end;
  135.   Adlib := AdlibPresent;
  136.   If Adlib then begin
  137.     writeln (SoundCard);
  138.     hsc_init;
  139.     hsc_set (@Music);
  140.     hsc_play (false);
  141.     delay (2000);
  142.   end;
  143.   for x := 1 to 25 do begin              { Fadeout the text screen  }
  144.     move (mem [$B800:0], mem [$B800:160], 160*24);
  145.     fillchar (mem [$B800:0], 160, 0);
  146.     repeat until port [$3da] and 8 = 8;
  147.     repeat until port [$3da] and 8 = 0;
  148.   end;
  149.   InitTables;                            { initialize vector tables }
  150.   InitModeX (m320x200, 320, 200, 4);     { Enter 320x200x256x4 mode }
  151.   move (MyPal^, Palette1, 768);
  152.   fillchar (TextBitmap, sizeof (TextBitmap), 0);
  153.   fillchar (Palette2, 768, 0);
  154.   for x := 0 to 255 do SinTable [x] := round (sin (x*2*pi/256)*48)+60;
  155.   Getfont;
  156.   CurPOS := 0;
  157.   CurSIN := $FE;
  158.   CurCHR := 1;
  159.   CurPAGE := 0;
  160.   rx := 0;   { x,y,z rotation angles }
  161.   ry := 45;
  162.   rz := 90;
  163.   vx := 0;
  164.   vy := 0;
  165.   vxi := 2;
  166.   vyi := 2;
  167.   getintvec (9, Old9);
  168.   setintvec (9, @Nothing);
  169.   port [$3c8] := 0;
  170.   for x := 0 to 767 do port [$3c9] := 0; { Clear palette            }
  171.   for x := 3 downto 0 do begin
  172.     set_active_page(x);
  173.     draw_Bitmap (MyPic^, 0, 0, 320, 200);  { Draw picture on screen   }
  174.   end;
  175.   for x := 0 to 63 do begin              { Fade in palette          }
  176.     port [$3c8] := 0;
  177.     For y := 0 to 767 do begin
  178.       If Palette2 [y] < Palette1 [y] then Inc (Palette2 [y]);
  179.       port [$3c9] := Palette2 [y];
  180.     end;
  181.     repeat until port [$3da] and 8 = 8;
  182.   end;
  183.   Randomize;
  184.   port [$3c8] := 255;
  185.   port [$3c9] := 63; port [$3c9] := 63; port [$3c9] := 63;
  186.   port [$3c8] := 254;
  187.   port [$3c9] := 43; port [$3c9] := 63; port [$3c9] := 43;
  188.   port [$3c8] := 253;
  189.   port [$3c9] := Random(63); port [$3c9] := Random(63); port [$3c9] := Random(63);
  190.   port [$3c7] := 0;
  191.   for x := 0 to 767 do Palette2 [x] := Port [$3c9];
  192.  
  193.   repeat
  194.     { first, process scroller ... }
  195.     for x := 0 to 7 do move (TextBitmap [x, 1], TextBitmap [x, 0], 79);
  196.     for x := 0 to 7 do
  197.       if (CharTable^ [ord (Scroller [curCHR]), x] shl curPOS) and 128 <> 0
  198.         then TextBitmap [x, 79] := 1 else TextBitmap [x, 79] := 0;
  199.     inc (CurPOS);
  200.     OldSIN := CurSIN;
  201.     CurSIN := (CurSIN - 1) and $FF;
  202.     if CurPOS = 8 then begin
  203.       CurPOS := 0;
  204.       inc (CurCHR);
  205.       if CurCHR > length (Scroller) then CurCHR := 1;
  206.     end;
  207.     { second, process vector coordinates... }
  208.     rx := (rx + 3) mod 360;     {+2}
  209.     ry := (ry + 4) mod 360;     {+1}
  210.     rz := (rz + 358) mod 360;   {-1}
  211.     CurSIZ := (CurSIZ + 1) mod 256;
  212.     PVal := Round (Sin (CurSIZ*2*pi/256)*80)*2;
  213.     Rotate (Vectors [1], TempVector, rx, ry, rz, VecPts);
  214.     PerspectiveMUL (TempVector, NewVector, VecPts);
  215.     vx := vx + vxi;
  216.     vy := vy + vyi;
  217.     if (vy = 56) or (vy = -56) then vyi := -vyi;
  218.     if (vx = 110) or (vx = -110) then vxi := -vxi;
  219.     { third, print the scroller ... }
  220.     Set_Active_Page ((CurPage+1) mod 3);
  221.     for x := 0 to 7 do for y := 1 to 79 do begin
  222.       yy := x*4 + SinTable [(y+CurSIN) and $FF];
  223.       xx := y*4;
  224.       zz := TextBitmap [x, y]+254;
  225.       if zz = 255 then begin
  226.         Set_Point (xx, yy, 255);
  227.         Set_Point (xx-1, yy, 254);
  228.         Set_Point (xx+1, yy, 254);
  229.         Set_Point (xx, yy-1, 254);
  230.         Set_Point (xx, yy+1, 254);
  231.       end;
  232.     end;
  233.     { fourth, print the vector... }
  234.     for x := 1 to 12 do
  235.       draw_line (
  236.       vx+NewVector [VectorLines [x, 1]].x, vy+NewVector [VectorLines [x, 1]].y,
  237.       vx+NewVector [VectorLines [x, 2]].x, vy+NewVector [VectorLines [x, 2]].y,
  238.         253);
  239.  
  240.     Set_Display_Page ((CurPage+1) mod 3);
  241.     Set_Active_Page (CurPage);
  242.     { fifth, Restore background }
  243.     Copy_Bitmap (3, 0, 0, 319, 199, CurPage, 0, 0);
  244.     CurPage := (CurPage + 1) mod 3;
  245.   until port [$60] = 1;                  { repeat until ESCape pressed }
  246.   for x := 0 to 63 do begin              { Fade out palette            }
  247.     port [$3c8] := 0;
  248.     For y := 0 to 767 do begin
  249.       If Palette2 [y] > 0 then Dec (Palette2 [y]);
  250.       port [$3c9] := Palette2 [y];
  251.     end;
  252.     repeat until port [$3da] and 8 = 8;
  253.   end;
  254.   asm                                    { set back 80x25x16 text mode }
  255.     mov  ax, 3
  256.     int  10h
  257.   end;
  258.   if Adlib then begin
  259.     hsc_stop;
  260.     hsc_deinit;
  261.   end;
  262.   writeln (Credits);                     { write the credits           }
  263.   setintvec (9, Old9);                   { restore back keyboard int.  }
  264. End.