The Equalizer BBS/equalizer-bbs-collection_2004.zip/equalizer-bbs-collection/DEMOSCENE-STUFF/HQ_WATER.ZIP/DROPS.PAS

Pascal/Delphi Source File | 1994-09-19 | 5KB | 278 lines

{
   DROPS.PAS  //  ARM 12/93

   rain drops / credits for <NONAME> (Iguana demo #2)
}

{$X+,G+,N-,S-,R-}

{x$DEFINE Stat }   { define stat to print frame count on exit }
{x$DEFINE Show }   { define show to show timer and WScp,SScp  }
{x$DEFINE fromX }  { define if starting in mode x }

Uses  PASDVT, GLOBAL, COLORS, BACKGRND, SKY, WATER;

procedure BRAND; assembler;
asm
  db '[[ ARM 12/93 ]]'
end;


function KeyPressed : boolean; assembler;
asm
  mov ah,1
  int $16
  mov al,0
  jz @1
  mov ah, 0
  int $16      { absorb key }
  mov al,1
@1:
end;


procedure UpdateTable; external;
procedure DrawSurf; external;
{$L surf.obj}

procedure InitTable;
var i : integer;
begin
  FillChar( U^, sizeof(TU), 0 );
  for i := 0 to NX-1 do TOPS[i] := 199*320+2*i;
end;

procedure WaitVR;
begin
  repeat until (Port[$3da] and 8)=0;
  while (Port[$3da] and 8)=0 do ;
end;


procedure FilterPalette;
var i : byte;
begin               { quirk: red component must be <63 for fade routine }
  for i := 0 to 255 do if RGB[i,0]=63 then RGB[i,0]:=62;
end;

{ ... }
procedure tweak;
begin
  PortW[ $3c4 ] := $0404;
  PortW[ $3d4 ] := $0014;
  PortW[ $3d4 ] := $e317;
  PortW[ $3ce ] := $ff08;
  PortW[ $3c4 ] := $0f02;
end;
procedure untweak;
begin
  PortW[ $3d4 ] := $000c;
  PortW[ $3d4 ] := $000d;
  PortW[ $3ce ] := $ff08;
  PortW[ $3c4 ] := $0f02;
  PortW[ $3c4 ] := $0c04;
  PortW[ $3d4 ] := $4014;
  PortW[ $3d4 ] := $a317;
end;

procedure Startup;
var P : PAL;
    C : CRGB;
    x : word;
begin
{
  asm
    mov ax,$13
    int $10
  end;
  for x := 0 to 320*200 do Mem[$a000:x] := x mod 320;
  readln;
  tweak;
}
  GetPalette( P, 0, 256 );
  FadeToColor  ( P, 63,63,63, 63 );
{$IFDEF fromX}  untweak;  {$ENDIF}
  C[0] := 63;  C[1] := 63;  C[2] := 63;
  for x := 0 to 255 do P[x] := C;
  FadeToColor  ( P, 16,16, 0, 63 );
end;

{ ... }

var
  timer,lastT: longint;
  thiscount : word;
  update_allowed : boolean;
  tmp  : pointer;
  vol  : byte;
  col  : byte;
  WScP : byte;
  SScP : byte;

BEGIN
{$IFNDEF fromX }
   asm
     mov ah,$0f
     int $10
     cmp al,$13
     je @@1
     mov ax,$13
     int $10
 @@1:
   end;
{$ENDIF}

   Startup;

   tmp := @BRAND;
   getmem( U, sizeof(TU) );
   getmem( tmp, sizeof(TB)+16 );
   asm
      mov dx, [word ptr tmp+2]
      mov ax, [word ptr tmp]
      or ax,ax
      jz @1
      xor ax,ax
      inc dx
    @1:                          { Make ofs(B^) be 0, so that     }
      mov [word ptr B], ax       {  we can use the same register  }
      mov [word ptr B+2], dx     {  for video-buf and B^ offsets. }
   end;

   InitTable;
   Leaving := False;
   Count := 1;
   CT := 1;

   if not VT_Init then halt(1);

   InitColors;
   InitBackground;
   FilterPalette;

   asm
     push ds
     lds si, B
     mov ax, $a000
     mov es, ax
     xor di,di
     mov cx, (200-NY)*160
     cld
     rep movsw
     pop ds
   end;
   DrawSurf;

   VT_AutoOn;
   VT_Start;

   while keypressed do ;  { absorb previous key strokes }

   FadeFromColor( RGB, 63,63, 0, 63 );

   vol := VT_GetVolume and not 15;
   col := 32;

   WScP := 0;
   SScP := 0;
   Damp := WScript[ 0 ].dens;
   SScript[ 0 ].first;

   lastT := -1;
   thiscount := 0;

   REPEAT

     timer := VT_Timer;

     { ----
       Weird way to limit speed of water while avoiding the jerkiness
       of DemoVT's timer... only problem is I can't really test it!
     }

     if timer <= lastT + 1 then
       inc( thiscount )
     else begin
       thiscount := 0;
       lastT := timer;
     end;
     update_allowed := (thiscount<2);

     { update_allowed := true; }

     { ---- }

     if update_allowed then begin
       UpdateTable;
       CT := 1-CT;
     end;

{$IFDEF Show}
     { print status to screen }

     gotoxy(1,1); write(timer:8);
     gotoxy(5,2); write(WScp:4);
     gotoxy(1,2); write(SScp:4);
{$ENDIF}

     { water script }

     if update_allowed then WScript[ WScP ].what;
     if WScp<NWScript-1 then
       if timer > WScript[ WScp+1 ].when then begin
         inc( WScP );
         Damp := WScript[ WScP ].dens;
     end;


     { sky script }

     DrawSurf;

     SScript[ SScP ].what;
     if SScp<NSScript-1 then
       if timer > SScript[ SScp+1 ].when then begin
         SScript[ SScp ].last;
         inc( SScP );
         SScript[ SScp ].first;
     end;


     inc( count );

     if not Leaving then begin
        if ( count and $0f ) = 0 then Leaving := KeyPressed;
     end else begin
        DimPalette( RGB, col );
        dec(col);
        if vol <> 0 then dec(vol,16);
        VT_SetVolume( vol );
     end;

  UNTIL col=0;

  if Leaving then VT_Abort;

  while vol <> 0 do begin
    dec(vol,4);
    VT_SetVolume(vol);
    DrawSurf;
  end;

{  VT_Delay(50); }

  asm
    mov ax,3
    int $10
  end;


{$IFDEF Stat}
  writeln( count );
{$ENDIF}

  FreeMem( tmp, sizeof(TB) );
  FreeMem( U, sizeof(TU) );
END.