Demo/BlackHole/blackhole.pas

   1 {$E-,I-,Q-,R-,S-,X-}
   2 Uses Blue_Cob,Crt,Tunplas;
   3
   4 {ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ}
   5
   6 Var x, xx, y     : Word;
   7     retr         : Boolean;
   8     ch           : Char;
   9     YWert        : Integer;
  10     plas,segmen3 : Pointer;
  11     XWerte       : Array[0..255] of Integer;
  12
  13 {ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ}
  14
  15 Const str =  ^j^j+'    "Black Hole" v1.1"'+^j^j^m
  16              +'    (C)opyright "Blue Cobold"¸ 2001'+^j^j^m
  17              +'    F�r Info''s bin ich zu erreichen unter'+^j^m
  18              +'    BlueCobold@gmx.de';
  19       quest = ^j^j^j^j+'    Retrace-Synchronisation? (J/N)';
  20
  21 Begin
  22   Ab_in_13h;
  23   asm mov ax,3; int 10h end;
  24   GetMem(plas,$ffff);
  25   GetMem(segmen3,$ffff);
  26   FillChar(plas^,$ffff,0);
  27   WriteLn(^j^j^j'                           ÉÍÍÍÍÍÍÍÍÍÍÍ»');
  28   WriteLn('    Berechne die Texturen: º           º');
  29   WriteLn('                           ÈÍÍÍÍÍÍÍÍÍÍÍ¼');
  30   GotoXY(29,5);
  31   CalcRain(plas,255);
  32   GotoXY(5,5);
  33   Write('Berechne das Loch:     º           ');
  34   GotoXY(29,5);
  35   CalcWorm(segmen3);
  36   ClrScr;
  37   Write(quest);
  38   Repeat ch:=Upcase(ReadKey) Until ch In ['J','N'];
  39   If ch='J' Then retr:=True Else retr:=False;
  40   asm mov ax,13h; int 10h end;
  41   asm cli end;  {}
  42   For x:= 0 To 63 Do
  43   Begin
  44     Farbe_setzen(     x,    x,    0,    0);
  45     Farbe_setzen(  x+64, 63-x,    0,    0);
  46     Farbe_setzen( x+128,    x,    x,    x);
  47     Farbe_setzen( x+192, 63-x, 63-x, 63-x);
  48   End;
  49   x:=0;
  50   Start;
  51   Repeat
  52     Inc(x);
  53     DoWorm(plas,segmen3,x*510);
  54     If retr Then Retrace;{}
  55     Bilde;
  56   Until Port[$60]=1;
  57   asm sti end;
  58   Raus_aus_13h;
  59   Write(str,^j^j^j^m, x/(Result/18.21):10:2,' Fps');
  60   FreeMem(plas,$ffff);
  61   FreeMem(segmen3,$ffff);
  62 End.