home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / GB_FMINT.ZIP / SRC / FLMINT.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-27  |  15KB  |  363 lines
  1. { Greetz go out to:    -> Bas Van Galen
  2.                             -> Denthor of Asphyxia
  3.                             -> eXtaCy
  4.                             -> If I Forgot Anyone .. Sorry! :(
  5.  
  6.                             -> ah! And Everyone that loves the Demoscene
  7. }
  8. {G+}
  9. program Flame_Intro;
  10. {$M 65520,0,65530}
  11. {                                  GarbaGe Flame Intro
  12.                                      -------------------
  13.  
  14.                     ->  Version 1.0 Beta Version
  15.  
  16.                     ->  Intro coded by Dea_db_raiN (aka VyPeR/AD)
  17.                     ->  OBJPCX unit coded by eXtaCy
  18.                     ->  CVGA256 unit coded by ????
  19.                     ->  Module playing routine by ????
  20.  
  21.     Note: If you want more comments ... write'em !!! I'm tired! :) }
  22.  
  23. Uses Dos,Crt,cvga256,ObjPcx;
  24.  
  25. type virtual=array[0..64000] of byte;
  26.       virtptr=^virtual;
  27.  
  28. {$L PIC.OBJ}
  29. procedure pic; external;
  30.  
  31. const
  32. {    PicPtr : VirtPtr = @Pic;}
  33.   GSeg = $a000;
  34.   Sofs = 100; Samp = 15; Slen = 255;
  35.   Size = 4; Curve = 6;
  36.   Xmax = 279 div Size; Ymax = 7;
  37.   ScrSpd = -4;
  38.   ScrText : string =
  39.      '      GarbaGe      the new underground group that loves the DemoScene.'+
  40.      ' This is our first intro w/ full pascal code. Greetz go out to Bas van '+
  41.      'Galen, Denthor Smith, Outlaw Triad, Radioactive Design and to our portuguese '+
  42.      'and spanish friends... :)     ';
  43.   palette : array [1..768] of byte = (
  44.      0,    0,    0,    0,    0,    24,    0,    0,    24,    0,    0,    28,
  45.      0,    0,   32,    0,    0,    32,    0,    0,    36,    0,    0,    40,
  46.      8,    0,   40,   16,    0,    36,   24,    0,    36,   32,    0,    32,
  47.     40,    0,   28,   48,    0,    28,   56,    0,    24,   64,    0,    20,
  48.     72,    0,   20,   80,    0,    16,   88,    0,    16,   96,    0,    12,
  49.   104,    0,    8,  112,    0,     8,  120,    0,     4,  128,    0,     0,
  50.   128,    0,    0,  132,    0,     0,  136,    0,     0,  140,    0,     0,
  51.   144,    0,    0,  144,    0,     0,  148,    0,     0,  152,    0,     0,
  52.   156,    0,    0,  160,    0,     0,  160,    0,     0,  164,    0,     0,
  53.   168,    0,    0,  172,    0,     0,  176,    0,     0,  180,    0,     0,
  54.   184,    4,    0,  188,    4,     0,  192,    8,     0,  196,    8,     0,
  55.   200,   12,    0,  204,   12,     0,  208,   16,     0,  212,   16,     0,
  56.   216,   20,    0,  220,   20,     0,  224,   24,     0,  228,   24,     0,
  57.   232,   28,    0,  236,   28,     0,  240,   32,     0,  244,   32,     0,
  58.   252,   36,    0,  252,   36,     0,  252,   40,     0,  252,   40,     0,
  59.   252,   44,    0,  252,   44,     0,  252,   48,     0,  252,   48,     0,
  60.   252,   52,    0,  252,   52,     0,  252,   56,     0,  252,   56,     0,
  61.   252,   60,    0,  252,   60,     0,  252,   64,     0,  252,   64,     0,
  62.   252,   68,    0,  252,   68,     0,  252,   72,     0,  252,   72,     0,
  63.   252,   76,    0,  252,   76,     0,  252,   80,     0,  252,   80,     0,
  64.   252,   84,    0,  252,   84,     0,  252,   88,     0,  252,   88,     0,
  65.   252,   92,    0,  252,   96,     0,  252,   96,     0,  252,  100,     0,
  66.   252,  100,    0,  252,  104,     0,  252,  104,     0,  252,  108,     0,
  67.   252,  108,    0,  252,  112,     0,  252,  112,     0,  252,  116,     0,
  68.   252,  116,    0,  252,  120,     0,  252,  120,     0,  252,  124,     0,
  69.   252,  124,    0,  252,  128,     0,  252,  128,     0,  252,  132,     0,
  70.   252,  132,    0,  252,  136,     0,  252,  136,     0,  252,  140,     0,
  71.   252,  140,    0,  252,  144,     0,  252,  144,     0,  252,  148,     0,
  72.   252,  152,    0,  252,  152,     0,  252,  156,     0,  252,  156,     0,
  73.   252,  160,    0,  252,  160,     0,  252,  164,     0,  252,  164,     0,
  74.   252,  168,    0,  252,  168,     0,  252,  172,     0,  252,  172,     0,
  75.   252,  176,    0,  252,  176,     0,  252,  180,     0,  252,  180,     0,
  76.   252,  184,    0,  252,  184,     0,  252,  188,     0,  252,  188,     0,
  77.   252,  192,    0,  252,  192,     0,  252,  196,     0,  252,  196,     0,
  78.   252,  200,    0,  252,  200,     0,  252,  204,     0,  252,  208,     0,
  79.   252,  208,    0,  252,  208,     0,  252,  208,     0,  252,  208,     0,
  80.   252,  212,    0,  252,  212,     0,  252,  212,     0,  252,  212,     0,
  81.   252,  216,    0,  252,  216,     0,  252,  216,     0,  252,  216,     0,
  82.   252,  216,    0,  252,  220,     0,  252,  220,     0,  252,  220,     0,
  83.   252,  220,    0,  252,  224,     0,  252,  224,     0,  252,  224,     0,
  84.   252,  224,    0,  252,  228,     0,  252,  228,     0,  252,  228,     0,
  85.   252,  228,    0,  252,  228,     0,  252,  232,     0,  252,  232,     0,
  86.   252,  232,    0,  252,  232,     0,  252,  236,     0,  252,  236,     0,
  87.   252,  236,    0,  252,  236,     0,  252,  240,     0,  252,  240,     0,
  88.   252,  244,    0,  252,  244,     0,  252,  244,     0,  252,  248,     0,
  89.   252,  248,    0,  252,  248,     0,  252,  248,     0,  252,  252,     0,
  90.   252,  252,    4,  252,  252,     8,  252,  252,    12,  252,  252,    16,
  91.   252,  252,   20,  252,  252,    24,  252,  252,    28,  252,  252,    32,
  92.   252,  252,   36,  252,  252,    40,  252,  252,    40,  252,  252,    44,
  93.   252,  252,   48,  252,  252,    52,  252,  252,    56,  252,  252,    60,
  94.   252,  252,   64,  252,  252,    68,  252,  252,    72,  252,  252,    76,
  95.   252,  252,   80,  252,  252,    84,  252,  252,    84,  252,  252,    88,
  96.   252,  252,   92,  252,  252,    96,  252,  252,   100,  252,  252,   104,
  97.   252,  252,  108,  252,  252,   112,  252,  252,   116,  252,  252,   120,
  98.   252,  252,  124,  252,  252,   124,  252,  252,   128,  252,  252,   132,
  99.   252,  252,  136,  252,  252,   140,  252,  252,   144,  252,  252,   148,
  100.   252,  252,  152,  252,  252,   156,  252,  252,   160,  252,  252,   164,
  101.   252,  252,  168,  252,  252,   168,  252,  252,   172,  252,  252,   176,
  102.   252,  252,  180,  252,  252,   184,  252,  252,   188,  252,  252,   192,
  103.   252,  252,  196,  252,  252,   200,  252,  252,   204,  252,  252,   208,
  104.   252,  252,  208,  252,  252,   212,  252,  252,   216,  252,  252,   220,
  105.   252,  252,  224,  252,  252,   228,  252,  252,   232,  252,  252,   236,
  106.   252,  252,  240,  252,  252,   244,  252,  252,   248,  252,  252,   252,
  107.   252,  252,  240,  252,  252,   244,  252,  252,   248,  252,  252,   252);
  108.  
  109.     radius    = 10 * pi;
  110.     frequency = 10 * pi;
  111.     angleinc  = 10 * frequency;
  112.     PicPtr : VirtPtr = @Pic;
  113.  
  114. type SinArray = array[0..Slen] of word;
  115.  
  116. var Stab : SinArray; Fseg,Fofs : word;
  117.     count       : word;
  118.     delta       : integer;
  119.     path        : array[0..199] of word;
  120.     buffer      : array[0..102,0..159] of integer;
  121.     virscr:pointer;
  122.     vaddr:word;
  123.  
  124.  
  125. procedure CalcSinus; var I : word; begin
  126.   for I := 0 to Slen do Stab[I] := round(sin(I*pi/Slen)*Samp)+Sofs; end;
  127.  
  128. procedure GetFont; assembler; asm
  129.   mov ax,1130h; mov bh,1; int 10h; mov Fseg,es; mov Fofs,bp; end;
  130.  
  131. procedure SetGraphics(Mode : word); assembler; asm
  132.   mov ax,Mode; int 10h end;
  133.  
  134. function keypressed : boolean; assembler; asm
  135.   mov ah,0bh; int 21h; and al,0feh; end;
  136.  
  137. procedure Scroller;
  138. type
  139.   ScrArray = array[0..Xmax,0..Ymax] of byte;
  140.   PosArray = array[0..Xmax,0..Ymax] of word;
  141. var
  142.   PosTab : PosArray;
  143.   BitMap : ScrArray;
  144.   X,I,SinIdx : word;
  145.   Y,ScrIdx,CurChar : byte;
  146. begin
  147.   fillchar(BitMap,sizeof(BitMap),0);
  148.   fillchar(PosTab,sizeof(PosTab),0);
  149.   ScrIdx := 4; SinIdx := 0;
  150.   repeat
  151.      Curchar := ord(ScrText[ScrIdx]);
  152.      inc(ScrIdx); if ScrIdx = length(ScrText) then ScrIdx := 1;
  153.      for I := 0 to 7 do begin
  154.         move(BitMap[1,0],BitMap[0,0],(Ymax+1)*Xmax);
  155.         for Y := 0 to Ymax do
  156.           if ((mem[Fseg:Fofs+8*CurChar+Y] shl I) and 128) <> 0 then
  157.              BitMap[Xmax,Y] := ((ScrIdx+Y-I) mod 60)+25 else BitMap[Xmax,Y] := 0;
  158.         while (port[$3da] and 8) <> 0 do;
  159.         while (port[$3da] and 8) = 0 do;
  160.         for X := 0 to Xmax do
  161.           for Y := 0 to Ymax do begin
  162.              mem[vaddr:PosTab[X,Y]] := 0;
  163.              PosTab[X,Y] := (Size*Y+STab[(SinIdx+X+Curve*Y) mod
  164.                              SLen])*320+Size*X+STab[(X+Y) mod SLen]-SOfs;
  165.              mem[vaddr:PosTab[X,Y]] := BitMap[X,Y];
  166.           end;
  167.         SinIdx := (SinIdx+ScrSpd) mod SLen;
  168.      end;
  169.     flip(vaddr,Gseg);
  170.     waitretrace;
  171.  
  172.       asm
  173.           mov   bx,8             { ; BX := 1                              }
  174.           mov   si,offset path   { ; SI := path[0]                        }
  175.  
  176.           mov   cx,16160         { ; CX := # of elements to change        }
  177.           mov   di,offset buffer { ; DI := buffer[0]                      }
  178.           add   di,220           { ; DI := buffer[320] (0,1)              }
  179.  
  180.       @l2:
  181.  
  182.           mov   ax,ds:[di-2]     { ; AX := buffer[DI-2]    (x-1,y)        }
  183.           add   ax,ds:[di]       { ; AX += buffer[DI]      (x  ,y)        }
  184.           add   ax,ds:[di+2]     { ; AX += buffer[DI+2]    (x+1,y)        }
  185.           add   ax,ds:[di+320]   { ; AX += buffer[DI+320]  (x,y+1)        }
  186.           shr   ax,2             { ; AX := AX div 4 (calc average)        }
  187.  
  188.           jz    @l3              { ; if AX = 0 then skip next line        }
  189.           dec   ax               { ; else AX--                            }
  190.  
  191.       @l3:
  192.  
  193.           push  di               { ; save DI                              }
  194.           sub   di,ds:[si]       { ; DI := (x + or - sin,y-1)             }
  195.           mov   word ptr ds:[di],ax { store AX somewhere one line up      }
  196.           pop   di               { ; restore DI                           }
  197.  
  198.           inc   di               { ; DI++                                 }
  199.           inc   di               { ; DI++ (move to next word)             }
  200.  
  201.           inc   bx               { ; BX++                                 }
  202.           cmp   bx,320           { ; if bx <> 320                         }
  203.           jle   @l4              { ; then jump to @l4                     }
  204.           mov   bx,1             { ; else BX := 1 (we're on a new line)   }
  205.           inc   si               { ; point SI to next element in path     }
  206.           inc   si               { ;                                      }
  207.  
  208.       @l4:
  209.           dec   cx               { ; CX--                                 }
  210.           jnz   @l2              { ; if CX <> 0 then loop                 }
  211.       end;
  212.  
  213.       for count := 60 to 100 do {set new bottom line}
  214.           begin
  215.               if random < 0.1 then
  216.                   delta := random(2)*200;
  217.               buffer[101,count] := delta;
  218.               buffer[102,count] := delta;
  219.           end;
  220.  
  221.       asm
  222.           mov   si,offset buffer { ; SI := buffer[0]                      }
  223.           mov   ax,0A000h        { ; AX := 0A000h (vga segment)           }
  224.           mov   es,ax            { ; ES := AX                             }
  225.           xor   di,di            { ; DI := 0                              }
  226.           mov   dx,100           { ; DX := 100 (# of rows div 2)          }
  227.  
  228.       @l5:
  229.           mov   bx,1             { ; BX := 2                              }
  230.  
  231.       @l6:
  232.           mov   cx,150           { ; CX := 160 (# of cols div 2)          }
  233.  
  234.       @l7:
  235.           mov   al,ds:[si]       { ; AL := buffer[si]                     }
  236.           mov   ah,al            { ; AH := AL (replicate byte)            }
  237.           mov   es:[di],ax       { ; store two bytes into video memory    }
  238.           inc   di               { ; move to next word in VRAM            }
  239.           inc   di               { ;                                      }
  240.           inc   si               { ; move to next word in buffer          }
  241.           inc   si               { ;                                      }
  242.           dec   cx               { ; CX--                                 }
  243.           jnz   @l7              { ; repeat until done with column        }
  244.  
  245.           sub   si,320           { ; go back to start of line in buffer   }
  246.           dec   bx               { ; BX--                                 }
  247.           jnz   @l6              { ; repeat until two columns filled      }
  248.  
  249.           add   si,320           { ; restore position in buffer           }
  250.           dec   dx               { ; DX--                                 }
  251.           jnz   @l5              { ; repeat until 100 rows filled         }
  252.       end;
  253.   until keypressed;
  254. end;
  255.  
  256. Procedure Cls (Col : Byte; where:word);
  257.     (* To Clear The Screen With A Specified Color *)
  258. begin
  259.   Fillchar (Mem [where:0],64000,col);
  260. end;
  261.  
  262. procedure buildpath;
  263.     var
  264.         count     : byte;
  265.         currangle : real;
  266.     begin
  267.         currangle := pi;
  268.         for count := 0 to 180 do
  269.             begin
  270.                 path[count] := 220 + round(radius*cos(currangle));
  271.  
  272.                 { the sin path _must_ lie on an even number }
  273.                 { otherwise the picture will be garbage     }
  274.  
  275.                 if path[count] mod 2 <> 0 then
  276.                     if path[count] > 320 then
  277.                         dec(path[count])            { round down }
  278.                     else
  279.                         inc(path[count]);           { round up   }
  280.  
  281.                 { the path is rounded to the closest even number to 320 }
  282.  
  283.                 currangle := currangle + angleinc;
  284.             end;
  285.     end;
  286.  
  287. {------------------  Music Programming  ----------------------}
  288. {$L PLAYER.DAT}
  289. {$F+}
  290. Procedure ModVolume(v1,v2,v3,v4: integer); External;
  291. Procedure ModDevice(Var device: integer); External;
  292. Procedure ModSetup(Var status: integer;device,mixspeed,pro,loop: integer;Var str: String); External;
  293. Procedure ModStop; External;
  294. Procedure ModInit; External;
  295. {$F-}
  296.  
  297. Procedure ModPlay(Str: String);
  298. Var Dev, Mix, Stat, Pro, Loop: Integer;
  299. Begin
  300.     ModInit;
  301.     Mix := 10000; Dev := 7; Pro := 10; Loop := 4;
  302.     ModVolume (255,255,255,255);
  303.     ModSetup ( Stat, Dev, Mix, Pro, Loop, Str );
  304. End;
  305.  
  306.  
  307. {--------------------- Main Program -----------------------}
  308. begin
  309.   waitretrace;
  310.   fadeout (0);
  311.   ModPlay('flmint.mod');
  312.   SetGraphics($13);
  313.   getmem(virscr,64000);
  314.   vaddr:=seg(virscr^); cls(0,vaddr);
  315.   ReadObjPcx(vga,@pic);
  316.   asm mov ah,13h; int 10h; end;
  317.   setPCXPal(@pic,17858);
  318.     delay(3200);
  319.   waitretrace;
  320.   fadeout (0);
  321.   cls(0,vga);
  322.   delay(500);
  323.  
  324.     randomize;
  325.   CalcSinus;
  326.   GetFont;
  327.   buildpath;
  328.   asm
  329.       xor   ax,ax               { ; AX := 0                              }
  330.       mov   cx,768              { ; CX := # of palette entries           }
  331.       mov   dx,03C8h            { ; DX := VGA Port                       }
  332.       mov   si,offset palette   { ; SI := palette[0]                     }
  333.  
  334.       out   dx,al               { ; send zero to index port              }
  335.       inc   dx                  { ; inc to write port                    }
  336.  
  337.     @l1:
  338.  
  339.       mov   bl,[si]             { ; set palette entry                    }
  340.       shr   bl,2                { ; divide by 4                          }
  341.       mov   [si],bl             { ; save entry                           }
  342.       outsb                     { ; and write to port                    }
  343.       dec   cx                  { ; CX := CX - 1                         }
  344.       jnz   @l1                 { ; if not done then loop                }
  345.  
  346.       mov   ax,seg buffer       { ; AX := segment of buffer              }
  347.       mov   es,ax               { ; ES := AX                             }
  348.       mov   di,offset buffer    { ; DI := buffer[0]                      }
  349.       mov   cx,9109             { ; CX := sizeof(buffer) div 2           }
  350.       xor   ax,ax               { ; AX := 0                              }
  351.       rep   stosw               { ; clear every element in buffer to zero}
  352.   end;
  353.   waitretrace;
  354.   Scroller;
  355.   waitretrace;
  356.   fadeout (0);
  357.   freemem(virscr,64000);
  358.   ModStop;
  359.   SetGraphics(3);
  360.   Writeln ('-- Flame Intro -- by GarbaGe');
  361.   Writeln ;
  362.   Writeln ('Coded by: DeadbraiN');
  363. end.